如何复制非相邻列？Excel VBA复制D、H列至表格求助

看起来你的代码核心问题是没处理非相邻列的复制逻辑，原代码复制的是D到H的连续区域，而你需要的是单独的D列和H列。另外还有几个小细节可以优化，我帮你调整一下：

原代码的主要问题 #

• 错误地复制了D到H的连续列，而非你需要的D列和H列
• Application.ScreenUpdating 的开关搞反了，应该先关闭再开启
• 不必要的Sheets("Source").Select 会降低代码效率
• 仅复制常量单元格可能会漏掉带公式的内容（如果你的数据有公式的话）

修正后的代码 #

Sub Zulily_DS()
    On Error Resume Next
    Dim lastRowSourceB As Long
    Dim lastRowZulilyD As Long
    Dim copyRange As Range
    
    ' 关闭屏幕刷新，提升运行速度
    Application.ScreenUpdating = False
    
    With Sheets("Zulily_DS")
        ' 获取Zulily_DS表中D列最后一行有数据的行号
        lastRowZulilyD = .Cells(.Rows.Count, "D").End(xlUp).Row
        ' 合并D列和H列的目标区域（从第2行到最后一行）
        Set copyRange = Union(.Range("D2:D" & lastRowZulilyD), .Range("H2:H" & lastRowZulilyD))
    End With
    
    With Sheets("Source")
        ' 获取Source表中B列最后一行的行号
        lastRowSourceB = .Cells(.Rows.Count, "B").End(xlUp).Row
        
        ' 根据C2的值判断粘贴位置
        If .Range("C2").Value = vbNullString Then
            ' C2为空，粘贴到B列最后一行的位置（不换行）
            copyRange.Copy .Cells(lastRowSourceB, "B")
        ElseIf .Range("C2").Value > "0" Then
            ' C2大于0，粘贴到B列最后一行的下一行
            copyRange.Copy .Cells(lastRowSourceB + 1, "B")
        End If
    End With
    
    ' 恢复屏幕刷新
    Application.ScreenUpdating = True
    Set copyRange = Nothing ' 释放对象变量
End Sub

代码说明 #

• 使用Union方法合并D列和H列的非相邻区域，实现精准复制
• 去掉了不必要的Select操作，直接通过工作表对象引用，更高效
• 修正了Application.ScreenUpdating的逻辑，先关闭后恢复，避免屏幕闪烁
• 如果你的数据包含公式，不需要仅复制常量的话，可以去掉原代码里的SpecialCells(xlCellTypeConstants)（上面的修正代码已经去掉了）
• 变量名更清晰，方便后续维护

如果运行时遇到错误，可以把On Error Resume Next暂时注释掉，这样能看到具体的错误提示，方便排查问题。

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