Excel获取不同工作簿内相同名称的工作表

Excel获取不同工作簿内相同名称的工作表

好几年前处理工作单的时候用过，想起来也是相当久没有用过excel，也把一丢丢的VBA sense给丢了。再用的时候，头皮抓破也想不起要怎么写。

看了Excelhome看了百度看了CSDN，翻查了很久，终于找到个合适的代码，稍微改动即可使用，感谢作者，忘记链接了，如果作者看到，想要添加名或者链接，请留言告诉我。

Ctrl/Command + Shift + K

Sub GetExcleWS() ’获取不同工作簿内相同工作表并生成一个新工作表
    Dim path As String, filename As String
    Dim w As Workbook, ws As Workbook
    
    path = "C:\Users\Data Collect"
    filename = Dir(path & "\Summ_*.xlsx")  'ws 工作簿保存所有复制的工作表    
   Application.DisplayAlerts = False '提示关闭
    Set ws = Workbooks.Add
    
    Do While filename <> "" 
         Set w = Workbooks.Open(path & "\" & filename) ‘W 为文件夹内符合要求的工作簿
            w.Sheets("Summary").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 & "\"Template_Data"&"ddmmyy.hhmmss"&.xlsx"  ’保存新工作簿
End Sub

没用过markdown编辑器，不懂怎么用。发出来试试。

用以存档