用VBA拆分工作表，按工作表表名进行拆分

Sub SplitWorksheetsByName()

Dim wb As Workbook
Dim ws As Worksheet
Dim newWb As Workbook
Dim newWs As Worksheet
Dim sheetName As String
Dim savePath As String

Set wb = ActiveWorkbook

For Each ws In wb.Worksheets
    sheetName = ws.Name
    Set newWb = Workbooks.Add
    Set newWs = newWb.Sheets(1)
    ws.Copy newWs
    newWs.Name = sheetName
    savePath = wb.Path & "\" & sheetName & ".xlsx"
    newWb.SaveAs savePath
    newWb.Close
Next ws

End Sub