Sub 合并所有工作簿的第?个工作表到当前工作簿()
Dim MyFile, MyPath, MyName
MyPath = ThisWorkbook.Path& "\"
MyName = Dir(MyPath& "*.xlsx")
Do While MyName<> ""
If MyName<> "." And MyName<> ".." And MyName<>http://www.doczj.com/doc/510d8b17ae45b307e87101f69e3143323968f5cd.html Then Workbooks.Open Filename:=MyPath&MyName
newname = Application.Substitute(http://www.doczj.com/doc/510d8b17ae45b307e87101f69e3143323968f5cd.html, ".xlsx", "")
i = 1 '工作簿将第1个sheet合并
Sheets(i).Copy before:=ThisWorkbook.Sheets(1)
a = newname
http://www.doczj.com/doc/510d8b17ae45b307e87101f69e3143323968f5cd.html = a '新表名称为工作簿名称
Workbooks(MyName).Close savechanges + False
End If
MyName = Dir ' 查找下一个目录。
Loop
Application.DisplayAlerts = False '不出现对话框,按对话框默认选择
End Sub
讲要合并的excel全部放到一个文件夹下,新建一个excel并打开,右键某一sheet,查看代码,讲上方代码全部粘贴进去,点击运营