如何用VBA将大量的工作簿的内容以分表的形式复制到一个汇总工作簿里

Sub xcj()

mypath = ThisWorkbook.Path '获取当前工作簿的路径

Filename = Dir(mypath & "\*.xls") '获取当前路径下所有的文件名称，这里所指工作簿的名称名称都一样，如下，只是结尾的数字不一样

Set wk_zb = Workbooks("访问统计表-Office 高级应用与VBA（INF0402A）-2018年04月02日-18.xls") '命名为汇总表为哪一个现有的表

While Filename <> " "    

bg = Split(Filename, "_")(3)   ' 这里获取的是工作簿名称

bg = Split(bg, ".")(0)     '再一次获取更详细的数字

If bg <> "18" Then        

Set wk_fb = Workbooks.Open(mypath & "\" & Filename)        

wk_fb.Sheets("在线统计导出").Copy wk_zb.Sheet(1)   ' 这里是将表放在的总表的第一张前面     

wk_zb.Sheets("在线统计导出").Name = bg   ' 将工作表重命名为刚刚提取出来的数字，以此辨别     

wk_fb.Save        

wk_fb.Close    

End If    

Filename = Dir Wend wk_zb.SaveAs mypath & "\汇总表.xls" '打开下一个工作簿，循环上面的操作

wk_zb.Close

End Sub