VBA 合并多个excel

Sub 汇总()

Dim myPath$, myFile$, AK As Workbook, aRow%, tRow%, i As Integer
Application.ScreenUpdating = False        '冻结屏幕，以防屏幕抖动
myPath = ThisWorkbook.Path & "\VMS基础信息表（寿险汇总）\"          '把文件路径定义给变量

myFile = Dir(myPath & "*.xlsx")            '依次找寻指定路径中的*.xls文件
Do While myFile <> ""                     '当指定路径中有文件时进行循环
If myFile <> ThisWorkbook.Name Then
Set AK = Workbooks.Open(myPath & myFile)          '打开符合要求的文件
For i = 1 To AK.Sheets.Count
If AK.Sheets(i).Name = "附表一之二 纳税主体" Then
aRow = AK.Sheets(3).Range("b65536").End(xlUp).Row
tRow = ThisWorkbook.Sheets(1).Range("b65536").End(xlUp).Row + 1

'AK.Sheets(i).Select
AK.Sheets(3).Range("A8:r" & aRow).Copy ThisWorkbook.Sheets(1).Range("a" & tRow)
End If
Next
Workbooks(myFile).Close False               '关闭源工作簿,并不作修改
End If
myFile = Dir                                   '找寻下一个*.xls文件
Loop

Application.ScreenUpdating = True                 '冻结屏幕,此类语句一般成对使用
MsgBox "汇总完成，请查看！", 64, "提示"

End Sub