Excel多Sheet拆分与合并 - 亲测可用

Excel多Sheet拆分与合并

一、Excel多个Sheet拆分

1.打开Excel，鼠标右击sheet栏，【查看代码】
2.将如下代码复制进去，并执行

Private Sub 分拆工作表()
       Dim sht As Worksheet
       Dim MyBook As Workbook
       Set MyBook = ActiveWorkbook
       For Each sht In MyBook.Sheets
           sht.Copy
           ActiveWorkbook.SaveAs Filename:=MyBook.Path & "\" & sht.Name, FileFormat:=xlWorkbookDefault  '将工作簿另存为EXCEL默认格式
           ActiveWorkbook.Close
       Next
       MsgBox "文件已经被分拆完毕!"
   End Sub

3.选择存放目录等

二、多个Excel合并成一个Excel（每个Sheet则是一个原Excel）

1.打开Excel，鼠标右击sheet栏，【查看代码】
2.将如下代码复制进去，并执行

Sub Workbook_merge()
Rem This script is used to collect worksheets of serval workbooks into one workbook!

Dim FileOpen
Dim X As Integer
Dim Wb As Workbook
Dim sh As Worksheet
Application.ScreenUpdating = False
FileOpen = Application.GetOpenFilename(FileFilter:="Microsoft Excel Workbook(*.xlsx),*.xlsx", MultiSelect:=True, Title:="Please select the Workbooks you want to merge:")
X = 1
Application.DisplayAlerts = False
While X <= UBound(FileOpen)
      Set Wb = GetObject(FileOpen(X))
      For Each sh In Wb.Sheets
          If Application.WorksheetFunction.CountA(sh.Cells) <> 0 Then
             sh.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
          End If
      Next
      Wb.Close SaveChanges:=False
      X = X + 1
Wend
Application.DisplayAlerts = False
ThisWorkbook.Save
Application.ScreenUpdating = True
End Sub

3.一次可选择多个Excel