Excel VBA代码问题：将Compare列数据间隔粘贴至P&L行

原代码问题分析 #

• 依赖Select和ActiveCell：切换工作表时，ActiveCell会自动切换到目标工作表单元格，导致循环逻辑混乱，无法正确遍历Compare列的下一个单元格。
• 目标位置未动态更新：colRange始终指向初始找到的列，每次粘贴都覆盖同一位置，未实现“间隔2个单元格”的要求。
• 未处理Find失败场景：如果Compare工作表A列全为空，代码会直接报错。

修正后的代码 #

Sub CopyandPaste()
    Dim comp As Worksheet, PL As Worksheet
    Dim firstNonBlank As Range, currentCompCell As Range
    Dim targetCol As Range
    
    ' 初始化工作表对象
    Set comp = ActiveWorkbook.Worksheets("Compare")
    Set PL = ActiveWorkbook.Worksheets("P&L")
    
    ' 获取P&L工作表第5行最右侧的非空列，作为起始目标列
    Set targetCol = PL.Cells(5, Columns.Count).End(xlToLeft)
    
    ' 找到Compare工作表A列第一个非空单元格
    Set firstNonBlank = comp.Columns("A").Find(what:="*", after:=comp.Cells(1, 1), LookIn:=xlFormulas)
    
    ' 如果找到非空单元格，开始遍历
    If Not firstNonBlank Is Nothing Then
        Set currentCompCell = firstNonBlank
        Do Until IsEmpty(currentCompCell.Value)
            ' 直接赋值替代复制粘贴，更高效
            targetCol.Offset(0, 2).Value = currentCompCell.Value
            
            ' 更新目标列：向右偏移2个单元格
            Set targetCol = targetCol.Offset(0, 2)
            ' 移动到Compare列的下一个单元格
            Set currentCompCell = currentCompCell.Offset(1, 0)
        Loop
    End If
End Sub

核心修正点 #

• 取消Select/ActiveCell操作：用Range变量直接跟踪单元格，避免工作表切换导致的上下文混乱。
• 动态更新目标列：每次粘贴后将目标列向右偏移2个单元格，实现间隔粘贴的需求。
• 增加空值判断：检查Find结果是否存在，避免A列全空时触发错误。
• 直接赋值替代复制粘贴：跳过剪贴板操作，提升代码执行效率。

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