多工作簿合并到一个工作簿(Excel代码集团)


同一文件夹内N个工作簿,每个工作簿中一个工作表,最终合并到一个工作簿内分工作表显示的代码。

假设放置以下代码的文件命名为“合并.xlsm“,并与待合并文件在同一文件夹内。

Sub Sample()
Application.DisplayAlerts = False
Dim MyWb As Workbook
Dim MyName As String, MyPath As String
MyPath = ThisWorkbook.Path & "\"
MyName = Dir(MyPath & "*.xls*")
Do While MyName <> ""
    If MyName <> ThisWorkbook.Name Then
        Set MyWb = Workbooks.Open(MyPath & MyName)
        ActiveSheet.Name = Left(MyName, Len(MyName) - 5)
        ActiveSheet.Copy Before:=Workbooks("合并.xlsm").Sheets(1)
        MyWb.Close False
    End If
    MyName = Dir
Loop
Application.DisplayAlerts = True
End Sub