复制所有打开工作簿工作表时遇Error 1004问题求助

问题根源 #

你的宏报错核心原因是循环包含了目标工作簿All.xlsm本身：当遍历所有打开的工作簿时，All.xlsm会被纳入循环范围，此时尝试将它内部的工作表复制到自身的第一个工作表之前，这种自引用操作会触发Excel的1004错误。另外，如果工作簿里存在隐藏工作表，Sheets集合会包含这类表，复制隐藏表也可能引发同类错误。

修复后的代码 #

Sub AllInOne()
    Dim sW As Workbook
    Dim sS As Worksheet
    Dim targetWB As Workbook
    
    ' 锁定目标工作簿，避免循环时误处理
    Set targetWB = Workbooks("All.xlsm")
    
    For Each sW In Workbooks
        ' 跳过目标工作簿，避免自复制冲突
        If Not sW Is targetWB Then
            For Each sS In sW.Sheets
                ' 可选：仅复制可见工作表，规避隐藏表引发的错误
                If sS.Visible = xlSheetVisible Then
                    sS.Copy Before:=targetWB.Sheets(1)
                End If
            Next sS
        End If
    Next sW
End Sub

关键改动说明 #

• 提前定义targetWB指向目标工作簿，既避免重复查找，也明确排除它的循环处理。
• 增加If Not sW Is targetWB Then判断，彻底跳过目标工作簿的遍历，从根源消除自复制冲突。
• 可选添加If sS.Visible = xlSheetVisible Then判断，只复制可见工作表，规避隐藏表复制可能触发的错误。

额外注意事项 #

• 确保All.xlsm处于打开状态，若不确定可增加判断逻辑避免找不到文件的错误：

  On Error Resume Next
  Set targetWB = Workbooks("All.xlsm")
  On Error GoTo 0
  If targetWB Is Nothing Then
      MsgBox "目标工作簿All.xlsm未打开"
      Exit Sub
  End If
  

• 如果工作簿中有受保护的工作表，复制前需要先解除保护（可添加sS.Unprotect Password:="你的密码"操作），否则也会触发1004错误。
• 若存在同名工作表，Excel会自动在新复制的表名后添加序号（如Sheet1(2)），无需额外处理，但需确保工作表名称符合Excel命名规则。

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