Sub 合并多工作簿()
Dim MyPath As String, MyFile As String, i As Integer
Dim Wb As Workbook, arr
Application.ScreenUpdating = False
MyPath = ThisWorkbook.Path
MyFile = Dir(MyPath & "\*.xls")
Do Until MyFile = ""
If MyFile <> ThisWorkbook.Name Then
Set Wb = Workbooks.Open(MyPath & "\" & MyFile)
For i = 1 To Wb.Worksheets.Count
arr = Sheets(i).UsedRange
ThisWorkbook.Sheets(i).Range("A" & rows.count).End(xlUp).Offset(1).Resize(UBound(arr), UBound(arr, 2)) = arr
Next
Wb.Close
End If
MyFile = Dir
Loop
Application.ScreenUpdating = True
End Sub
将代码粘贴至汇总工作薄的代码窗口中运行，代码来自
http://wenwen.sogou.com/z/q403377230.htm。