VBA复制粘贴行触发运行时错误1004（工作表名称冲突）问题求解

你写的Closed工作表的SelectionChange事件逻辑存在错误，是触发报错的核心原因：

• 该事件是Closed工作表的私有事件，仅当Closed工作表的单元格被选中时触发
• 在Opened表激活状态下执行粘贴操作时，粘贴动作会选中Closed表的目标单元格，触发该SelectionChange事件
• 此时活动工作表仍然是Opened，事件中的判断逻辑ActiveSheet.name <> "Closed"成立，会尝试将当前活动的Opened表重命名为Closed，但已存在同名工作表，因此抛出1004报错
• 当Closed表处于激活状态时运行代码，判断逻辑不成立，所以不会触发错误。

方案1：替换错误的禁止重命名逻辑（推荐） #

你原来用SelectionChange事件实现禁止改工作表名的方式不合理，建议替换成Workbook_SheetRename事件，放到工作簿模块（ThisWorkbook）里，代码如下：

Private Sub Workbook_SheetRename(ByVal Sh As Object)
    ' 禁止将Closed表重命名，也禁止其他表改名为Closed
    If Sh.Name = "Closed" Or Sh.CodeName = "Closed" Then ' 用CodeName更稳妥，避免名称被改后匹配不上
        Application.EnableEvents = False
        Sh.Name = "Closed"
        Application.EnableEvents = True
        MsgBox "该工作表名称禁止修改", vbExclamation
    End If
End Sub

写完之后把原来放在Closed工作表模块里的SelectionChange事件代码删掉即可，该方案可以从根本上满足禁止重命名的需求，也不会误改其他工作表名称。

方案2：临时禁用事件避免误触发（如果不想调整原有重命名逻辑） #

修改你的复制粘贴代码，运行前先禁用事件，运行完再恢复，避免触发不必要的工作表事件：

Sub Copy_PasteSpecial()
    Dim StatusColumn As Range
    Dim DestRng As Range
    Dim Cell As Object
    ' 运行前禁用事件
    Application.EnableEvents = False
    
    Set StatusColumn = Sheets("Opened").Range("H3", Sheets("Opened").Cells(Rows.Count, "H").End(xlUp))
    
    For Each Cell In StatusColumn
        If Cell.Value = "Close" Then
            Set DestRng = Sheets("Closed").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
            Cell.EntireRow.Copy
            DestRng.PasteSpecial xlPasteValuesAndNumberFormats
            DestRng.PasteSpecial xlPasteFormats
            ' 清空剪贴板避免残留提示
            Application.CutCopyMode = False
        End If
    Next Cell
    
    ' 运行结束恢复事件
    Application.EnableEvents = True
End Sub

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