Excel VBA实现Master工作表增删行同步至多个子表故障求助

问题根因 #

• 缺少旧数据清空逻辑：原有代码仅执行新数据粘贴，未提前删除子表A、B列已有的同步数据，Master删除内容时旧数据残留，就会出现仅部分内容被删除的异常
• 范围取值逻辑错误：命名为destinationLastRow的变量实际获取的是Master表的最后一行，当Master删除所有数据仅剩表头时，会生成Range("A2:A1")这类无效逆序范围，Excel会自动识别为Range("A1:A2")，导致表头被误复制到子表
• 未做事件防重入：Worksheet_Change事件中调用修改单元格的代码会再次触发Change事件，造成递归执行，逻辑混乱
• 仅支持单表同步：代码硬编码目标表名，无法实现所有子表同步需求

修复后完整代码 #

标准模块同步逻辑 #

Sub SyncMasterToAllSheets()
    Dim sourceWs As Worksheet, ws As Worksheet
    Dim sourceLastRow As Long, targetLastRow As Long
    
    Set sourceWs = ThisWorkbook.Worksheets("Master")
    sourceLastRow = sourceWs.Range("A" & Rows.Count).End(xlUp).Row
    
    ' 关闭事件与屏幕更新，避免递归、提升运行效率
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
    ' 异常捕获，防止代码崩溃后事件永久关闭
    On Error GoTo ErrHandler
    
    ' 遍历所有非Master工作表执行同步
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> sourceWs.Name Then
            ' 先清空子表A、B列原有同步数据，保留表头
            targetLastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
            If targetLastRow >= 2 Then
                ws.Range("A2:B" & targetLastRow).ClearContents
            End If
            
            ' Master有数据时才执行复制，避免空范围错误
            If sourceLastRow >= 2 Then
                sourceWs.Range("A2:B" & sourceLastRow).Copy Destination:=ws.Range("A2")
            End If
        End If
    Next ws
    
ErrHandler:
    ' 恢复系统设置
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    If Err.Number <> 0 Then MsgBox "同步失败：" & Err.Description
End Sub

Master表Change事件代码 #

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 仅监听A、B列变更触发同步
    If Not Intersect(Target, Me.Columns("A:B")) Is Nothing Then
        SyncMasterToAllSheets
    End If
End Sub

功能说明 #

• 全表自动同步：自动识别所有除Master外的工作表执行同步，无需手动指定表名
• 完全对齐Master：每次同步先清空子表旧数据，新增、删除操作都会完全同步
• 边界异常兼容：Master为空时不会误复制表头，避免子表出现多余内容
• 不影响子表自定义内容：仅修改A、B两列的ID和名称，子表其他列的业务数据不受影响
• 防卡死设计：同步过程关闭事件触发，不会出现递归执行导致的Excel卡死问题

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