VBA 复制同文件夹下多工作簿中同名工作表 分别粘贴至同一工作簿的不同工作表
https://blog.csdn.net/qq_30687601/article/details/86929458
学习日志
复制指定目录下excel工作簿中同名工作表,该代码将在相同目录下创建汇总工作簿,各工作簿中同名工作表将被分别复制到汇总工作簿的不同表中(汇总工作簿中各工作表以分工作簿名命名)。
所有要汇总的工作簿在同一个文件夹中,这里以后缀为.xlsx为例;
ALL excelfiles
Sub allexclefiles()
Dim path As String, filename As String
Dim w As Workbook, ws As Workbook
path = "C:\12"
filename = Dir(path & "\*.xlsx")
'ws工作簿保存所有单位excel表格花名册
'关闭提示
Application.DisplayAlerts = False
Set ws = Workbooks.Add
Do While filename <> ""
'w代表指定文件夹下每个找到的excel文件
Set w = Workbooks.Open(path & "\" & filename)
'选择工作表(此处假设sheet1),复制,并粘贴为汇总表的最后一张
w.Sheets("sheet1").Copy after:=ws.Sheets(ws.Sheets.Count)
'重命名刚贴的表名为excel文件名
ws.Worksheets(ws.Sheets.Count).name = Mid(filename, 1, Len(filename) - 5)
'关闭工作簿
w.Close
'下一个
filename = Dir
Loop
'程序运行结束,打开提示
Application.DisplayAlerts = True
'保存结果
ws.SaveAs path & "\汇总.xlsx"
End Sub
标签:VBA,filename,工作,文件夹,ws,Sheets,下多,path
From: https://www.cnblogs.com/zkwarrior/p/17120785.html