VBA 复制同文件夹下多工作簿中同名工作表 分别粘贴至同一工作簿的不同工作表

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