Sub CombineSheets()
    '活頁簿存放路徑，可自行修改存放路徑
    Path = "C:\test\"
    Filename = Dir(Path & "*.xl*")

    Do While Filename <> ""
        Workbooks.Open Filename:=Path & Filename, ReadOnly:=True

        For Each Sheet In ActiveWorkbook.Sheets

          If Sheet.Name <> "Sheet1" And Sheet.Name <> "Sheet2" Then
              Sheet.Copy After:=ThisWorkbook.Sheets(1)
              ActiveSheet.Name = Filename
          End If

        Next Sheet

        Workbooks(Filename).Close
        Filename = Dir()
    Loop
End Sub