VBA实现多工作表指定列复制并排粘贴问题求助

你的代码存在三个核心问题导致数据堆叠而非并排：循环逻辑混乱、字典构建时机错误、逐列粘贴的逻辑缺陷。以下是修正后的代码及说明：

修正后的代码 #

Sub CopySpecifiedColumns()
    Dim ws As Worksheet
    Dim wsTarget As Worksheet
    Dim colDict As Object
    Dim targetHeaderRow As Long
    Dim sourceHeaderRow As Long
    Dim targetLastRow As Long
    Dim sourceLastRow As Long
    Dim targetCol As Long
    Dim sourceCol As Long
    Dim targetColsCount As Long
    Dim i As Long
    
    ' 指定目标工作表（此处为第2个工作表，可按需修改）
    Set wsTarget = Worksheets(2)
    ' 定义表头行号（假设源表和目标表的表头都在第2行）
    targetHeaderRow = 2
    sourceHeaderRow = 2
    
    ' 构建目标表头与列索引的映射字典
    Set colDict = CreateObject("Scripting.Dictionary")
    targetColsCount = wsTarget.Cells(targetHeaderRow, Columns.Count).End(xlToLeft).Column
    For i = 1 To targetColsCount
        colDict(wsTarget.Cells(targetHeaderRow, i).Value) = i
    Next i
    
    ' 遍历所有工作表，跳过目标表避免重复处理
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> wsTarget.Name Then
            ' 获取目标表当前最后一行，后续数据从该行开始追加
            targetLastRow = wsTarget.Cells(Rows.Count, 1).End(xlUp).Row + 1
            
            ' 匹配并复制指定列数据
            For Each key In colDict.Keys
                sourceCol = 0
                ' 在源表表头中查找匹配列
                On Error Resume Next
                sourceCol = ws.Rows(sourceHeaderRow).Find(key, LookIn:=xlValues, LookAt:=xlWhole).Column
                On Error GoTo 0
                
                If sourceCol <> 0 Then
                    ' 获取源表该列的最后数据行
                    sourceLastRow = ws.Cells(Rows.Count, sourceCol).End(xlUp).Row
                    ' 将源表数据复制到目标表对应列的指定位置
                    wsTarget.Cells(targetLastRow, colDict(key)).Resize(sourceLastRow - sourceHeaderRow).Value = _
                        ws.Cells(sourceHeaderRow + 1, sourceCol).Resize(sourceLastRow - sourceHeaderRow).Value
                End If
            Next key
        End If
    Next ws
    
    ' 释放对象
    Set colDict = Nothing
    Set wsTarget = Nothing
End Sub

关键修正点 #

• 优化循环逻辑：遍历工作表时跳过目标表，避免无效处理；统一获取目标表的追加起始行，确保所有列数据从同一行开始粘贴，保证列对齐。
• 提前构建字典：一次性建立目标表头与列号的映射，避免重复遍历表头，提升效率。
• 错误容错处理：通过On Error Resume Next处理找不到匹配列的情况，防止代码崩溃。

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