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