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工作表中整加一個按鈕控件，指定宏，點擊運行效果如下：
