VBA-合并多个工作簿

1.首先我们理清思路，我们将所有要合并到一起的Excel工作簿放到一个文件夹里，该文件夹里面有一个启用宏的工作表，启动该工作表的宏，就可以将该文件夹里面的所有Excel文件的内容合并到一张表里面，后面可以将合并完成后的数据复制或剪切到新的Excel表中。

2.代码如下

Sub 合并目录所有工作簿全部工作表()

Dim MP, MN, AW, Wbn, wn

Dim Wb As Workbook

Dim i, a, b, d, c, e

Application.ScreenUpdating = False

MP = ActiveWorkbook.Path '获取当前工作薄的路径

MN = Dir(MP & "\" & "*.xls") '遍历Excel文件

AW = ActiveWorkbook.Name '获取当前工作簿名称

Num = 0

e = 1

Do While MN <> ""

If MN <> AW Then

Set Wb = Workbooks.Open(MP & "\" & MN)

a = a + 1

With Workbooks(1).ActiveSheet

For i = 1 To Sheets.Count
'复制工作表内容

If Sheets(i).Range("a1") <> "" Then

Wb.Sheets(i).Range("a1").Resize(1, Sheets(i).UsedRange.Columns.Count).Copy .Cells(1, 1)

d = Wb.Sheets(i).UsedRange.Columns.Count

c = Wb.Sheets(i).UsedRange.Rows.Count - 1
'增加一列
wn = Wb.Sheets(i).Name

.Cells(1, d + 1) = "表名"

.Cells(e + 1, d + 1).Resize(c, 1) = MN & wn

e = e + c

Wb.Sheets(i).Range("a2").Resize(c, d).Copy .Cells(.Range("a1048576").End(xlUp).Row + 1, 1)

End If

Next

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

Wb.Close False

End With

End If

MN = Dir

Loop

Range("a1").Select

Application.ScreenUpdating = True

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

End Sub

3.在Excel工作表中整加一个按钮控件，指定宏，点击运行效果如下：