SheetChange事件VBA代码报错：特定单元格变更时复制内容至其他工作表

原代码核心问题 #

• 未限定SalesStage、CID命名区域的所属工作表，默认指向当前激活表，若修改操作的表与命名区域所在表不一致会触发引用错误
• Range("TC").End(xlDown).Rows.End(xlDown)逻辑冗余且错误，重复使用xlDown可能定位到无效行
• 使用Copy方法会连带复制格式，不符合仅复制内容的需求
• 未处理多单元格同时修改的场景（如批量粘贴），会触发下标越界错误
• 写入Sheet3时未关闭事件，会递归触发Workbook_SheetChange导致死循环

修正后的代码 #

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim srcWs As Worksheet
    Dim destWs As Worksheet
    Dim lastRow As Long
    Dim targetCol As Integer
    Dim cidCol As Integer
    Dim salesStageCol As Integer
    
    ' 关闭事件避免递归触发
    Application.EnableEvents = False
    
    On Error GoTo Cleanup ' 错误捕获，确保事件能恢复
    
    ' 指定命名区域所在的工作表（替换为实际表名，比如"Sheet1"）
    Set srcWs = ThisWorkbook.Worksheets("Sheet1")
    Set destWs = ThisWorkbook.Worksheets("Sheet3")
    
    ' 获取命名区域的列号
    targetCol = srcWs.Range("SalesStage").Column
    cidCol = srcWs.Range("CID").Column
    salesStageCol = srcWs.Range("SalesStage").Column
    
    ' 仅处理Target在SalesStage列的单个单元格变更
    If Target.Column = targetCol And Target.Cells.Count = 1 Then
        ' 定位Sheet3中TC区域下方的第一个空行
        If destWs.Range("TC").Offset(1).Value = "" Then
            lastRow = destWs.Range("TC").Row + 1
        Else
            lastRow = destWs.Range("TC").End(xlDown).Row + 1
        End If
        
        ' 写入当前时间
        destWs.Cells(lastRow, destWs.Range("TC").Column).Value = Now()
        ' 仅复制CID内容
        destWs.Cells(lastRow, destWs.Range("TC").Column + 1).Value = srcWs.Cells(Target.Row, cidCol).Value
        ' 仅复制SalesStage内容
        destWs.Cells(lastRow, destWs.Range("TC").Column + 2).Value = srcWs.Cells(Target.Row, salesStageCol).Value
    End If

Cleanup:
    ' 恢复事件
    Application.EnableEvents = True
    If Err.Number <> 0 Then
        MsgBox "操作出错：" & Err.Description, vbExclamation
    End If
End Sub

关键修正说明 #

• 明确指定命名区域所属工作表，避免激活表切换导致的引用错误
• 优化目标行定位逻辑，先判断TC区域下一行是否为空，再决定是否使用End(xlDown)
• 使用Value直接赋值替代Copy，确保仅复制内容不携带格式
• 增加多单元格修改判断，仅处理单个单元格变更的场景
• 添加事件关闭与错误捕获，防止递归触发和异常导致事件无法恢复

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