Excel VBA拆分工作簿时报错1004 提示无法复制该工作表

触发Run-time error '1004': We couldn't copy this sheet.的常见原因包括：

• 工作表名称包含Windows系统或Excel不允许出现在文件名中的特殊字符：\、/、:、*、?、"、<、>、|，原代码直接取工作表名作为输出文件名，碰到这类字符会触发复制、保存流程失败
• 运行代码前当前工作簿从未执行过保存操作，此时ActiveWorkbook.Path属性返回空值，拼接得到的文件保存路径无效
• 原代码遍历ThisWorkbook.Sheets集合，该集合包含图表页、宏表等非普通工作表对象，这类对象直接执行Copy操作会触发兼容性错误
• 代码未明确指定保存文件格式，当源工作簿为启用宏的格式（.xlsm、.xls）时，直接存储为.xlsx后缀会触发格式校验报错
• 目标存储路径下已存在同名输出文件，且该文件处于被其他程序打开占用的状态，无法执行覆盖写入
• 目标工作表被设置为保护状态、或为深度隐藏状态，没有足够权限执行复制操作

修复后的代码补全了路径校验、非法字符清洗、对象类型过滤、格式指定、错误捕获逻辑，可稳定执行拆分：

Sub SplitEachWorksheet()
    Dim FPath As String
    Dim ws As Object
    Dim saveName As String
    Dim invalidChars As Variant
    Dim i As Integer
    
    ' 定义Windows文件名禁止使用的非法字符列表
    invalidChars = Array("\", "/", ":", "*", "?", """", "<", ">", "|")
    
    ' 校验源工作簿是否已保存，避免路径为空
    If ThisWorkbook.Path = "" Then
        MsgBox "请先保存当前工作簿后再运行拆分逻辑", vbExclamation
        Exit Sub
    End If
    FPath = ThisWorkbook.Path
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    ' 仅遍历普通工作表，排除图表、宏表等特殊Sheet对象
    For Each ws In ThisWorkbook.Worksheets
        ' 仅处理可见工作表，跳过隐藏/深度隐藏的工作表
        If ws.Visible = xlSheetVisible Then
            ' 替换工作表名中的非法字符为下划线
            saveName = ws.Name
            For i = LBound(invalidChars) To UBound(invalidChars)
                saveName = Replace(saveName, invalidChars(i), "_")
            Next i
            
            ' 单表复制错误捕获，避免单个表异常中断整体流程
            On Error Resume Next
            ws.Copy
            If Err.Number <> 0 Then
                MsgBox "工作表【" & ws.Name & "】复制失败，已自动跳过", vbExclamation
                Err.Clear
                GoTo NextLoop
            End If
            
            ' 明确指定xlsx格式保存，避免格式兼容报错
            Application.ActiveWorkbook.SaveAs _
                Filename:=FPath & "\" & saveName & ".xlsx", _
                FileFormat:=xlOpenXMLWorkbook
            Application.ActiveWorkbook.Close False
            On Error GoTo 0
        End If
NextLoop:
    Next ws
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "工作表拆分执行完成", vbInformation
End Sub

注意：运行代码前请关闭目标路径下所有和输出文件同名的已打开Excel文件，避免文件占用导致的写入失败。

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