多個工作簿拆分（Excel代碼集團）

一個文件夾里有N個工作簿，每個工作簿中包括N個工作表，將各個工作表拆分成工作簿，命名為每個工作簿里第一個工作表的A列和B列。

工作簿、工作表數量不定，表內內容不限，拆分后保存於當前文件夾下的“示例文件夾”內。

Sub SplitSheets()
Application.DisplayAlerts = False
Dim MyPath As String
Dim MyBook
Dim MySheetsCount As Long, i As Long
Dim MyName
MyPath = ThisWorkbook.Path
MyBook = Dir(MyPath & "\*.xlsx")
Do While MyBook <> ""
    If MyBook <> ThisWorkbook.Name Then
        i = 1
        With Workbooks.Open(MyBook)
                MyName = Sheets(1).Range("a2").Resize(Cells(Rows.Count, 2).End(xlUp).Row - 1, 2)
            For MySheetsCount = 2 To Sheets.Count
                .Sheets(MySheetsCount).Copy
                ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\示例文件\" & MyName(i, 1) & MyName(i, 2) & ".xlsx"
                i = i + 1
                ActiveWindow.Close
            Next
        End With
        ActiveWindow.Close
    End If
    MyBook = Dir
Loop
Set MyBook = Nothing
Application.DisplayAlerts = True
End Sub