Excel VBA遍历有色单元格并复制粘贴问题求助

我帮你排查了代码里的几个问题，调整后就能实现你想要的功能了——遍历指定区域，找到填充色为RGB(250,191,143)的单元格，把左侧内容复制到右侧，再把相关内容粘贴到另一工作表。

修改后的完整代码 #

Sub LoopForCondFormatCells()
    Dim sht3 As Worksheet, sht4 As Worksheet
    Dim ColB As Range, c As Range
    Dim pasteRow As Long ' 记录目标工作表的粘贴行
    
    ' 初始化工作表对象
    Set sht3 = ThisWorkbook.Sheets("Compare")
    Set sht4 = ThisWorkbook.Sheets("Print ready")
    
    ' 指定要遍历的单元格区域
    Set ColB = sht3.Range("G3:G86")
    
    ' 初始化粘贴起始位置（可根据实际需求修改）
    pasteRow = 1
    
    For Each c In ColB.Cells
        ' 判断单元格填充色是否符合要求
        If c.Interior.Color = RGB(250, 191, 143) Then
            ' 第一步：把当前单元格左侧内容复制到右侧单元格
            c.Offset(0, -1).Copy Destination:=c.Offset(0, 1)
            
            ' 第二步：复制当前单元格的左右区域（左侧到右侧）
            sht3.Range(c.Offset(0, -1), c.Offset(0, 1)).Copy
            
            ' 第三步：粘贴到目标工作表，自动下移粘贴位置避免覆盖
            sht4.Cells(pasteRow, 1).PasteSpecial xlPasteAll ' 可按需改为xlPasteFormats等
            pasteRow = pasteRow + 1
        End If
    Next c
    
    ' 清除剪贴板，避免弹窗提示
    Application.CutCopyMode = False
End Sub

关键修改点说明 #

• 规范变量定义：给所有变量指定明确类型，新增pasteRow管理目标工作表的粘贴位置，解决原代码中未定义HosKvikOff导致的错误。
• 简化单元格操作：直接用Offset操作单元格，不需要把地址转成字符串再引用，既高效又减少出错概率。
• 补全核心步骤：原代码漏掉了「把左侧单元格内容复制到右侧」的关键操作，现在通过c.Offset(0, -1).Copy Destination:=c.Offset(0, 1)补全。
• 避免激活工作表：直接通过工作表对象（sht3、sht4）操作单元格，不用Activate，代码更稳定。
• 自动管理粘贴位置：用pasteRow变量每次粘贴后自动加1，避免覆盖之前的内容，你可以根据需求调整起始行和列。
• 清理剪贴板：最后加上Application.CutCopyMode = False，避免Excel保留剪贴板内容导致的弹窗提示。

如果你的HosKvikOff是特定命名区域或固定单元格，只需把pasteRow = 1改成对应的起始位置即可，比如从sht4的B5开始粘贴，就改成pasteRow = 5，粘贴列改为Cells(pasteRow, 2)。

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