VBA 合并工作簿的工作表(2种方法)

1. 将同一工作簿内各张明细表合并到“汇总表”中

Sub 合并当前工作簿下的所有工作表()

Application.ScreenUpdating = False

For j = 1 To Sheets.Count

If Sheets(j).Name <> ActiveSheet.Name Then

X = Cells(Rows.Count,1).End(xlUp).Row + 1

Sheets(j).UsedRange.Copy Cells(X, 1)

End If

Next

Application.ScreenUpdating = True

MsgBox "当前工作簿下的全部工作表已经合并完毕！", vbInformation, "提示"

End Sub

注意：此代码是把每个sheet里面的内容（包括标题行）直接复制到汇总sheet里了，所以汇总后需要手动删除多余的表头。

2. 将多个工作簿中的表格合并到同一个工作簿的同一张表中

Sub 合并当前目录下所有工作簿的全部工作表()

Dim MyPath, MyName, AWbName

Dim Wb As Workbook, WbN As String

Dim G As Long

Dim Num As Long

Dim BOX As String

Application.ScreenUpdating = False

MyPath = ActiveWorkbook.Path

MyName = Dir(MyPath & "\" & "*.xlsx")

AWbName = ActiveWorkbook.Name

Num = 0

Do While MyName <> ""

If MyName <> AWbName Then

Set Wb = Workbooks.Open(MyPath & "\" & MyName)

Num = Num + 1

With Workbooks(1).ActiveSheet

.Cells(.Range("B65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4)

For G = 1 To Sheets.Count

Wb.Sheets(G).UsedRange.Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1)

Next

WbN = WbN & Chr(13) & Wb.Name

Wb.Close False

End With

End If

MyName = Dir

Loop

Application.ScreenUpdating = True

MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下：" & Chr(13) & WbN, vbInformation, "提示"

End Sub

注意此代码合并的是扩展名为xlsx的工作簿中的表，如果扩展名为xls，请修改代码中红色字体部分，请根据自己的版本更改。

本文来源：https://www.wddqw.com/doc/b3d2ae6d3269a45177232f60ddccda38376be185.html