多工作表的横向汇总 | VBA实例教程

Sub 横向汇总()
Dim myPath$, myFile$, AK As Workbook, tcol%, i As Integer
Application.ScreenUpdating = False        '冻结屏幕，以防屏幕抖动
myPath = ThisWorkbook.Path & "\"          '把文件路径定义给变量
Cells.Clear
myFile = Dir(myPath & "*.xls")            '依次找寻指定路径中的*.xls文件
Do While myFile <> ""                     '当指定路径中有文件时进行循环
If myFile <> ThisWorkbook.Name Then
Set AK = Workbooks.Open(myPath & myFile)          '打开符合要求的文件
tcol = ThisWorkbook.Sheets(1).Range("iv3").End(xlToLeft).Column + 1  '找到当前文件夹最右边的列+1
AK.Sheets(1).Range("a1:f33").Copy ThisWorkbook.Sheets(1).Cells(1, tcol)
Workbooks(myFile).Close False               '关闭源工作簿,并不作修改
End If
myFile = Dir                                   '找寻下一个*.xls文件
Loop
Application.ScreenUpdating = True                 '冻结屏幕,此类语句一般成对使用
MsgBox "汇总完成！", 64, "提示"
End Sub