VBA-合並多個工作簿

'合並多個工作薄，並以工作薄的名字給sheet表命名(每個工作薄只有一張表)
Sub test()
Dim str As String
Dim wb As Workbook
str = Dir("C:\Users\Administrator\Desktop\6.3_6.7\*.xls*")
For i = 1 To 100
    Set wb = Workbooks.Open("C:\Users\Administrator\Desktop\6.3_6.7\" & str)
    '文件匯總
    wb.Sheets(1).Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    '使用文件名命名sheet表名,帶文件后綴名。
    'ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = wb.Name
   '使用split分隔，實現去掉后綴
   ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = Split(wb.Name, ".")(0)
   
    wb.Close
    str = Dir
    If str = "" Then
    Exit For
    End If
    
Next

End Sub

 

'一個工作簿有多個sheet表,以sheet表的名字命名
Sub test()
Dim str As String
Dim wb As Workbook
Dim sht As Worksheet
str = Dir("E:\data\*.xls*")
For i = 1 To 100
    Set wb = Workbooks.Open("E:\data\" & str)
    '文件匯總
    For Each sht In wb.Sheets
    sht.Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
   'ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = Split(wb.Name, ".")(0) & sht.Name
   ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = sht.Name
   Next
   
    wb.Close
    str = Dir
    If str = "" Then
    Exit For
    End If
    
Next

End Sub