基于列标题将Sheet1数据同步至同工作簿其他多工作表的VBA问题

需求说明 #

我手里有个带11个工作表的Excel工作簿，所有表的第1行都是列标题，有些列标题是各个表共有的，但顺序不一样。Sheet1是数据源，得把Sheet1里的数据按照列标题对应，同步到剩下的所有工作表里。现在改了一段VBA代码，但只能处理单个目标工作表，原代码如下：

Sub AG()

    Dim ws_B As Worksheet
    Dim HeaderRow_A As Long
    Dim HeaderLastColumn_A As Long
    Dim TableColStart_A As Long
    Dim NameList_A As Object
    Dim SourceDataStart As Long
    Dim SourceLastRow As Long
    Dim Source As Variant
    Dim rowTarget As Long
    Dim iHighestUsedRow&
    Dim LastRow As Long
    Dim i As Long
    Dim ws_B_lastCol As Long
    Dim NextEntryline As Long
    Dim SourceCol_A As Long
 
    Set ws_A = Worksheets("Sheet1")
    Set ws_B = Worksheets("Sheet2")
    Set NameList_A = CreateObject("Scripting.Dictionary")
   
    With ws_A
        SourceDataStart = 2
        HeaderRow_A = 1
        TableColStart_A = 1
        HeaderLastColumn_A = .Cells(HeaderRow_A, Columns.Count).End(xlToLeft).Column
        
        iHighestUsedRow = 0
        
        For i = TableColStart_A To HeaderLastColumn_A
            If Not NameList_A.Exists(UCase(.Cells(HeaderRow_A, i).Value)) Then
                NameList_A.Add UCase(.Cells(HeaderRow_A, i).Value), i
            End If
        Next i
    End With

    With ws_B
        ws_B_lastCol = .Cells(HeaderRow_A, Columns.Count).End(xlToLeft).Column
        
        For i = 1 To ws_B_lastCol
            SourceLastRow = .Cells(Rows.Count, i).End(xlUp).Row
            
            If SourceLastRow > iHighestUsedRow Then
                iHighestUsedRow = SourceLastRow
            End If
        Next i
    End With

    With ws_B
        For i = 1 To ws_B_lastCol
            SourceCol_A = NameList_A(UCase(.Cells(1, i).Value))
    
            If SourceCol_A <> 0 Then
                SourceLastRow = ws_A.Cells(Rows.Count, SourceCol_A).End(xlUp).Row
                
                If SourceLastRow > 1 Then
                    Set Source = ws_A.Range(ws_A.Cells(SourceDataStart, SourceCol_A), ws_A.Cells(SourceLastRow, SourceCol_A))
                    NextEntryline = iHighestUsedRow + 1
        
                    .Range(.Cells(NextEntryline, i), _
                           .Cells(NextEntryline, i)) _
                           .Resize(Source.Rows.Count, Source.Columns.Count).Cells.Value = Source.Cells.Value
                End If
            End If

        Next i
    End With

End Sub

修改后的批量处理代码 #

把原代码改成遍历所有非Sheet1的工作表，就能实现批量同步了，修改后的代码如下：

Sub SyncDataToAllSheets()
    Dim ws_A As Worksheet
    Dim ws_B As Worksheet
    Dim HeaderRow_A As Long
    Dim HeaderLastColumn_A As Long
    Dim TableColStart_A As Long
    Dim NameList_A As Object
    Dim SourceDataStart As Long
    Dim SourceLastRow As Long
    Dim Source As Variant
    Dim iHighestUsedRow&
    Dim i As Long
    Dim ws_B_lastCol As Long
    Dim NextEntryline As Long
    Dim SourceCol_A As Long
 
    ' 设置数据源工作表
    Set ws_A = Worksheets("Sheet1")
    ' 创建列标题映射字典
    Set NameList_A = CreateObject("Scripting.Dictionary")
   
    ' 预构建数据源列标题的字典映射（只做一次，提升效率）
    With ws_A
        SourceDataStart = 2
        HeaderRow_A = 1
        TableColStart_A = 1
        HeaderLastColumn_A = .Cells(HeaderRow_A, Columns.Count).End(xlToLeft).Column
        
        For i = TableColStart_A To HeaderLastColumn_A
            If Not NameList_A.Exists(UCase(.Cells(HeaderRow_A, i).Value)) Then
                NameList_A.Add UCase(.Cells(HeaderRow_A, i).Value), i
            End If
        Next i
    End With

    ' 遍历工作簿中除Sheet1外的所有工作表
    For Each ws_B In ThisWorkbook.Worksheets
        If ws_B.Name <> ws_A.Name Then
            iHighestUsedRow = 0
            
            ' 找到当前目标表已使用的最大行号
            With ws_B
                ws_B_lastCol = .Cells(HeaderRow_A, Columns.Count).End(xlToLeft).Column
                
                For i = 1 To ws_B_lastCol
                    SourceLastRow = .Cells(Rows.Count, i).End(xlUp).Row
                    If SourceLastRow > iHighestUsedRow Then
                        iHighestUsedRow = SourceLastRow
                    End If
                Next i
            End With

            ' 按列标题匹配，同步数据源数据到目标表
            With ws_B
                For i = 1 To ws_B_lastCol
                    ' 匹配数据源对应的列，避免不存在的标题报错
                    If NameList_A.Exists(UCase(.Cells(1, i).Value)) Then
                        SourceCol_A = NameList_A(UCase(.Cells(1, i).Value))
                        SourceLastRow = ws_A.Cells(Rows.Count, SourceCol_A).End(xlUp).Row
                        
                        If SourceLastRow > 1 Then
                            Set Source = ws_A.Range(ws_A.Cells(SourceDataStart, SourceCol_A), ws_A.Cells(SourceLastRow, SourceCol_A))
                            NextEntryline = iHighestUsedRow + 1
            
                            .Range(.Cells(NextEntryline, i), .Cells(NextEntryline, i)) _
                               .Resize(Source.Rows.Count, Source.Columns.Count).Value = Source.Value
                        End If
                    End If
                Next i
            End With
        End If
    Next ws_B

    MsgBox "数据同步完成！", vbInformation
End Sub

关键修改点说明 #

• 新增For Each ws_B In ThisWorkbook.Worksheets循环，遍历所有非Sheet1的工作表作为目标表
• 把原代码中针对单个目标表的逻辑（找最大行号、同步数据）放到遍历循环内部
• 新增字典存在性判断，避免因目标表列标题在数据源中不存在导致的运行错误
• 最后添加完成提示框，方便快速确认同步状态

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