求助：如何用VBA将Sheet1指定列数据批量粘贴到Sheet2多列？

原代码存在的问题 #

• 复制区域错误：原代码选中Sheet1的C3:C，但需求是复制D3:D区域
• 粘贴区域错误：原代码选中Sheet2的A1:O，但需求是从第3行开始的A3:O区域
• 使用Select/Selection操作会降低代码效率，且易因工作表切换出错

修正后的代码 #

Sub CopyPasteData()
    ' 获取Sheet1中D列从D3到最后一行有数据的区域
    Dim copyRange As Range
    Set copyRange = Sheets("Sheet1").Range("D3:D" & Sheets("Sheet1").Cells(Rows.Count, "D").End(xlUp).Row)
    
    ' 计算Sheet2中粘贴区域的结束行，确保覆盖A到O列对应行数
    Dim pasteLastRow As Long
    pasteLastRow = 3 + copyRange.Rows.Count - 1
    Dim pasteRange As Range
    Set pasteRange = Sheets("Sheet2").Range("A3:O" & pasteLastRow)
    
    ' 执行复制粘贴
    copyRange.Copy pasteRange
    Application.CutCopyMode = False ' 清除复制状态
End Sub

关键修改说明 #

• 精准定位有效数据区域：通过Cells(Rows.Count, "D").End(xlUp).Row获取D列最后一行有数据的行号，避免复制大量空白单元格
• 匹配粘贴区域尺寸：根据复制区域的行数，计算Sheet2中粘贴区域的结束行，确保数据完整填充到A3开始的A至O列
• 移除冗余的Select操作：直接对单元格区域对象进行操作，提升代码稳定性和运行效率
• 清除复制模式：结束后关闭剪贴板的复制状态，避免后续操作受影响

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