批量将多个工作表另存为独立文件的VBA代码报错求助

现有代码的语法错误 #

• 数组最后一个元素后多余逗号："Sheet 24", _ 里的逗号需删除，VBA数组不允许最后一个元素带尾随逗号
• FileFormat: 51 应为 FileFormat:=51，VBA参数传递必须使用:=
• 定义了未使用的变量ARR，可直接删除
• 变量名大小写不一致（Filepath和FilePath），虽不影响运行，但建议统一格式

逻辑修正：拆分单个工作表为独立文件 #

原代码是将所有指定工作表合并到一个新文件，不符合“按工作表名称拆分为独立文件”的需求，以下是修正后的完整代码：

Sub DivideWorksheets()
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    
    Dim filePath As String
    Dim newFileName As String
    Dim ws As Worksheet
    Dim targetSheets As Variant
    
    ' 指定需要拆分的工作表名称数组
    targetSheets = Array( _
        "Sheet 1", "Sheet 2", "Sheet 3", "Sheet 4", "Sheet 5", "Sheet 6", _
        "Sheet 7", "Sheet 8", "Sheet 9", "Sheet 10", "Sheet 11", "Sheet 12", _
        "Sheet 13", "Sheet 14", "Sheet 15", "Sheet 16", "Sheet 17", "Sheet 18", _
        "Sheet 19", "Sheet 20", "Sheet 21", "Sheet 22", "Sheet 23", "Sheet 24" _
    )
    
    ' 获取桌面路径
    filePath = CreateObject("Script.Shell").SpecialFolders("Desktop")
    
    ' 遍历每个目标工作表，单独拆分保存
    For Each ws In ThisWorkbook.Sheets(targetSheets)
        ' 复制当前工作表到新工作簿
        ws.Copy
        ' 生成文件名：H1单元格内容 + 工作表名 + 后缀
        newFileName = ThisWorkbook.Range("H1").Value & " - " & ws.Name & ".xlsx"
        ' 保存并关闭新工作簿
        With ActiveWorkbook
            .SaveAs filePath & "\" & newFileName, FileFormat:=51
            .Close SaveChanges:=False
        End With
    Next ws
    
    Application.DisplayAlerts = True
    Application.EnableEvents = True
End Sub

适配其他3个文件的修改方法 #

1. 复制上述代码，新建3个不同的宏（可命名为DivideWorksheets_File1、DivideWorksheets_File2、DivideWorksheets_File3）
2. 修改每个宏里的targetSheets数组，替换为对应文件需要拆分的工作表名称
3. 若对应文件的命名规则不同，可直接修改newFileName的生成逻辑

内容的提问来源于stack exchange，提问作者BRS10121