Excel 巨集合併多個 Excel 檔案

上次遇到了同一個檔案中多個工作表合併到一個工作表裏，這次因為工作的關係又去找了多個不同的檔案，所有的工作表合併到同一個檔案中。

工作環境︰
Windows 10
M$ Office 2010

Sub CombineSheets()
    '活頁簿存放路徑，可自行修改存放路徑
    Path = "D:\資料夾名稱\"
    Filename = Dir(Path & "*.xl*")

    
    '避免工作表名字相同，重新命名
    i = 1
    
    Do While Filename <> ""
        Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
        
        For Each Sheet In ActiveWorkbook.Sheets
            Sheet.Copy After:=ThisWorkbook.Sheets(1)
            ActiveSheet.Name = i
            i = i + 1
        Next Sheet
        
        Workbooks(Filename).Close
        Filename = Dir()
    Loop
End Sub

收工！