|
学习日志
复制指定目录下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
|