Excel 如何合并多个工作表或多个工作簿？（VBA）

按Alt+F11两键，调出Visual Basic 界面，在左侧窗口中，右键选择“插入”—“模块”，将代码粘贴进去，点击运行按钮，完成数据表合并。

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，请修改代码中红色字体部分，请根据自己的版本更改。

3.  多个工作簿中指定的sheet合并到新的工作簿中

Sub 汇总数据（）

Application.ScreenUpdating = False

Dim wb, wb1 As Excel.Workbook

Dim sh As Excel.Worksheet

s = Split(ThisWorkbook.Name, ".")(1)

f = Dir(ThisWorkbook.Path & "\*" & s) '生成查找EXCEL的目录

Do While f <> "" '在目录中循环

    If f <> ThisWorkbook.Name Then  '如果不是打开的工作簿

        Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & f)

        wb.Worksheets("sheet1").Copy after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)

        ActiveSheet.Name = Split(wb.Name, ".")(0)

        wb.Close

    End If

    f = Dir

Loop

ThisWorkbook.Worksheets("汇总").Activate

Application.ScreenUpdating = True

End Sub