Sub test()
Dim arr()
Dim wb, wb1 As Workbook


'防止意外情況，將內(nèi)容復(fù)制到新建的表'
Set wb1 = Workbooks.Add
arr = Application.GetOpenFilename("Excel文件,*.xls*", , "請(qǐng)選擇", , True)

'防止用戶沒選的情況'
If arr(1) <> "False" Then
    For i = LBound(arr) To UBound(arr)
        Set wb = Workbooks.Open(arr(i))
        
        For Each sht In wb.Sheets
            sht.Copy after:=wb1.Sheets(wb1.Sheets.Count)
            wb1.Sheets(wb1.Sheets.Count).Name = Split(wb.Name, ".")(0) & sht.Name
        Next
        
        wb.Close
    Next
End If

End Sub

后續(xù)可保存為xla文件制作成加載宏按鈕