练习-合并多文件最终版

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


'防止意外情况,将内容复制到新建的表'
Set wb1 = Workbooks.Add
arr = Application.GetOpenFilename("Excel文件,*.xls*", , "请选择", , 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
后续可保存为xla文件制作成加载宏按钮

你可能感兴趣的:(练习-合并多文件最终版)