Excel VBA如何高效实现连续列到目标表非连续列的复制粘贴？

核心思路 #

通过数组定义源列和目标列的映射关系，用循环替代重复代码，同时支持直接赋值（无剪贴板，性能最优）和带格式复制两种场景。

实现代码 #

场景1：仅需复制数值（性能最优） #

无需调用剪贴板，运行速度是传统复制粘贴的3~10倍，适合数据量较大的场景：

Sub Transfer()
    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim nr_rows As Long, i As Long
    ' 配置项：按源列顺序填写目标表Basics对应的列标，用英文逗号分隔
    Const TARGET_COL_LIST As String = "E,F,H,J,K,M,O,P,R,S,T,V,X,Y,Z"
    Dim arrTargetCols As Variant
    
    Set wsSource = ThisWorkbook.Worksheets("1")
    Set wsTarget = ThisWorkbook.Worksheets("Basics")
    arrTargetCols = Split(TARGET_COL_LIST, ",")
    
    With wsSource
        nr_rows = .Range("A2").End(xlDown).Row
        ' 循环处理15列数据
        For i = 0 To 14
            wsTarget.Range(arrTargetCols(i) & "10").Resize(nr_rows - 1, 1).Value = _
                .Range(.Cells(2, i + 1), .Cells(nr_rows, i + 1)).Value
        Next i
    End With
End Sub

场景2：需要保留格式/公式 #

如果需要保留原单元格的格式、公式、数据验证等属性，使用带复制粘贴的循环版本：

Sub TransferWithFormat()
    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim nr_rows As Long, i As Long
    ' 配置项：按源列顺序填写目标表Basics对应的列标，用英文逗号分隔
    Const TARGET_COL_LIST As String = "E,F,H,J,K,M,O,P,R,S,T,V,X,Y,Z"
    Dim arrTargetCols As Variant
    
    Set wsSource = ThisWorkbook.Worksheets("1")
    Set wsTarget = ThisWorkbook.Worksheets("Basics")
    arrTargetCols = Split(TARGET_COL_LIST, ",")
    
    With wsSource
        nr_rows = .Range("A2").End(xlDown).Row
        ' 循环处理15列数据
        For i = 0 To 14
            .Range(.Cells(2, i + 1), .Cells(nr_rows, i + 1)).Copy _
                Destination:=wsTarget.Range(arrTargetCols(i) & "10")
        Next i
    End With
End Sub

使用说明 #

修改代码中TARGET_COL_LIST常量的内容，按照源表中15个相邻列的顺序，依次填写目标表Basics中对应的列标即可，无需调整其他逻辑。

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