多个工作簿拆分（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