下拉选A时如何仅触发当前行Macro复制X列数据到其他Worksheet

该需求可完全通过工作表自带的Worksheet_Change事件实现，无需遍历全列，仅响应单次修改操作。

部署步骤 #

• 按Alt+F11打开VBA编辑器，在左侧工程栏双击你放置审批下拉列的工作表，打开对应的工作表代码模块
• 将下方代码粘贴到模块中，修改代码开头标注的4个配置参数，匹配你实际的表结构
• 保存文件为启用宏的格式（.xlsm）即可生效

实现代码 #

Private Sub Worksheet_Change(ByVal Target As Range)
    ' ====================== 按需修改以下配置 ======================
    Const APPROVAL_COL As Long = 3       ' 审批下拉列表所在列号，例：C列填3
    Const DATA_COL As Long = 10          ' 需要复制的Column X列号，例：J列填10
    Const TARGET_SHEET As String = "表单" ' 接收数据的带表单工作表名称
    Const TARGET_PASTE_CELL As String = "B5" ' 目标表粘贴数据的起始单元格
    ' ============================================================

    ' 拦截非审批列、多单元格批量修改的操作，不触发宏
    Dim triggerRng As Range
    Set triggerRng = Intersect(Target, Me.Columns(APPROVAL_COL))
    If triggerRng Is Nothing Or triggerRng.Cells.Count > 1 Then Exit Sub
    
    ' 仅当选中值为"A"时继续执行
    If CStr(triggerRng.Value) <> "A" Then Exit Sub

    On Error GoTo ErrDeal
    Application.EnableEvents = False ' 临时关闭事件，避免递归触发宏

    ' 定位目标表下一个可粘贴的空行
    Dim targetWS As Worksheet
    Dim nextRow As Long
    Set targetWS = ThisWorkbook.Worksheets(TARGET_SHEET)
    nextRow = targetWS.Range(TARGET_PASTE_CELL).Offset(targetWS.Rows.Count - targetWS.Range(TARGET_PASTE_CELL).Row).End(xlUp).Row + 1

    ' 仅复制本次修改行对应列的数值到目标表
    targetWS.Cells(nextRow, targetWS.Range(TARGET_PASTE_CELL).Column).Value = _
        Me.Cells(triggerRng.Row, DATA_COL).Value

ExitSub:
    Application.EnableEvents = True ' 恢复事件监听
    Exit Sub
ErrDeal:
    MsgBox "宏运行错误：" & Err.Description, vbCritical
    Resume ExitSub
End Sub

逻辑说明 #

• 触发条件严格匹配需求：仅当用户在审批列单个单元格手动选中"A"的瞬间触发，不会响应列内其他值的修改，也不会遍历历史上所有值为"A"的单元格重复执行
• 操作范围严格限定在本次修改的行，不会影响其他行数据
• 内置异常保护，即使宏运行出错也会自动恢复事件监听，不会导致后续所有宏触发失效
• 如果需要复制该行多列数据、或者粘贴到目标表的固定位置而非逐行追加，只需修改代码中数据复制的对应段落即可，核心触发判断逻辑无需调整

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