Sub SplitExcelWorksheets()
    Dim FolderPath As String
    Dim SavePath As String
    Dim Filename As String
    Dim Sheet As Worksheet
    Dim NewWorkbook As Workbook
    Dim i As Integer
    
    ' Prompt user to select folder
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Title = "请选择要拆分的文件夹"
        .Show
        If .SelectedItems.Count = 0 Then Exit Sub
        FolderPath = .SelectedItems(1)
    End With
    
    ' Prompt user to select save folder
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Title = "请选择要保存的文件夹"
        .Show
        If .SelectedItems.Count = 0 Then Exit Sub
        SavePath = .SelectedItems(1)
    End With
    
    ' Loop through all Excel files in folder
    Filename = Dir(FolderPath & "\*.xls*")
    Do While Filename <> ""
        ' Open Excel file
        Set NewWorkbook = Workbooks.Open(FolderPath & "\" & Filename)
        
        ' Loop through all worksheets in workbook
        For i = 1 To NewWorkbook.Worksheets.Count
            Set Sheet = NewWorkbook.Worksheets(i)
            Sheet.Visible = xlSheetVisible ' 显示工作表
            
            ' Save worksheet as new workbook
            Sheet.Copy
            ActiveWorkbook.SaveAs SavePath & "\" & Left(Filename, InStrRev(Filename, ".") - 1) & "-" & Sheet.Name & ".csv", FileFormat:=xlCSV
            ActiveWorkbook.Close savechanges:=False
        Next i
        
        ' Close original workbook
        NewWorkbook.Close savechanges:=False
        
        ' Get next file name
        Filename = Dir()
    Loop
    MsgBox Prompt:="拆分完成", Buttons:=vbInformation + vbOKCancel, Title:="逗号Office技巧"
End Sub