Excel VBA多工作表数据引用：如何适配不同触发单元格区域

嘿，我来帮你搞定这个扩展需求！你的现有代码已经实现了基础的单工作表数据复制，要扩展到多工作表且对应不同触发单元格，核心思路是把触发单元格-目标工作表的对应关系做成可配置的，这样以后加新表只需要加配置项，不用反复修改核心代码。下面是具体的修改方案：

一、修改工作表事件代码（"Daily Testing"模块） #

我们把触发规则做成一个配置数组，新增触发关系只需要在数组里加一行即可。修改后的事件代码如下：

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 如果修改的是多个单元格或空单元格，直接退出
    If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
    ' 如果修改内容不是数值，直接退出（和原逻辑保持一致）
    If Not IsNumeric(Target) Then Exit Sub

    ' 核心配置：每个元素格式为 (触发单元格地址, 目标工作表名称)
    ' 后续加新表/新触发单元格，直接在这里追加行即可
    Dim sheetConfigs As Variant
    sheetConfigs = Array( _
        Array("B10", "Monthly Record"), _
        Array("C10", "Sheet3"), _
        Array("D10", "Sheet4") _
        ' 示例：Array("E10", "Sheet5")
    )

    Dim config As Variant
    On Error Resume Next
    Application.EnableEvents = False ' 关闭事件避免循环触发

    ' 遍历配置，找到匹配的触发单元格
    For Each config In sheetConfigs
        If Not Intersect(Target, Me.Range(config(0))) Is Nothing Then
            ' 调用通用更新过程，传递源表和目标表
            Call Update_TargetSheet(Me, Sheets(config(1)))
            Exit For ' 找到匹配项后退出循环，提升效率
        End If
    Next config

    Application.EnableEvents = True ' 恢复事件
    On Error GoTo 0
End Sub

二、替换原Update_Monthly为通用更新过程（标准模块） #

把原来针对单个工作表的复制逻辑改成通用化的子过程，支持传入源工作表和目标工作表参数，复用复制逻辑：

Sub Update_TargetSheet(sourceWs As Worksheet, targetWs As Worksheet)
    Application.ScreenUpdating = False ' 关闭屏幕刷新提升速度

    ' 获取目标工作表C列的最后一行
    Dim lastRow As Long
    lastRow = targetWs.Cells(targetWs.Rows.Count, "C").End(xlUp).Row

    ' 复制源表B6到B10的数据到目标表C列的下一行开始（和原逻辑一致）
    Dim i As Integer
    For i = 1 To 5
        targetWs.Cells(lastRow + i, "C") = sourceWs.Cells(5 + i, "B")
    Next i

    Application.ScreenUpdating = True ' 恢复屏幕刷新
End Sub

三、进阶：如果不同工作表需要复制不同区域/列 #

如果后续有需求，比如Sheet3需要复制C6-C10到D列，Sheet4复制D6-D10到E列，我们可以把配置再扩展一下，加入源数据区域和目标列：

修改后的事件代码配置部分： #

sheetConfigs = Array( _
    Array("B10", "Monthly Record", "B6:B10", "C"), _
    Array("C10", "Sheet3", "C6:C10", "D"), _
    Array("D10", "Sheet4", "D6:D10", "E") _
)

对应的通用更新过程： #

Sub Update_TargetSheet(sourceWs As Worksheet, targetWs As Worksheet, sourceRangeAddr As String, targetCol As String)
    Application.ScreenUpdating = False

    Dim lastRow As Long
    lastRow = targetWs.Cells(targetWs.Rows.Count, targetCol).End(xlUp).Row
    Dim sourceRng As Range
    Set sourceRng = sourceWs.Range(sourceRangeAddr)
    
    Dim rowOffset As Integer
    rowOffset = 1
    For Each cell In sourceRng
        targetWs.Cells(lastRow + rowOffset, targetCol) = cell.Value
        rowOffset = rowOffset + 1
    Next cell

    Application.ScreenUpdating = True
End Sub

事件代码中调用部分修改： #

把原来的Call Update_TargetSheet(Me, Sheets(config(1)))改成：

Call Update_TargetSheet(Me, Sheets(config(1)), config(2), config(3))

这样就完全灵活了，不管是触发单元格、目标工作表、源数据区域还是目标列，都可以通过配置快速调整，不用动核心复制逻辑。

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