VBA技术问题：如何根据条件格式单元格复制行

问题场景 #

需要将某工作表中因条件格式显示红色背景的行复制到另一工作表，红色背景触发条件为单元格数值超出公差。尝试Cells.DisplayFormat.Interior.Color = vbRed无法实现逐行搜索，用UsedRange.Rows.Count控制循环范围也未成功。

解决方案代码 #

Sub copy_formatted()
    
    Dim startRange As Range
    Dim copyRange As Range
    Dim i As Long
    Dim startOfRowCell As Range
    Dim Cell As Range
    
    ' 修改为源数据区域的左上角单元格
    Set startRange = Worksheets(2).Range("A5")
    ' 修改为目标粘贴区域的左上角单元格
    Set copyRange = Worksheets(1).Range("A5")
    ' 标记目标区域的下一个空行偏移量
    i = 0
    
    ' 遍历源表的所有数据行
    For Each startOfRowCell In Worksheets(2).Range(startRange, startRange.End(xlDown))
    
        ' 遍历当前行的所有单元格
        For Each Cell In Worksheets(2).Range(startOfRowCell, startOfRowCell.End(xlToRight))
    
            ' 检查单元格实际显示的背景色（适配条件格式）
            If Cell.DisplayFormat.Interior.Color = vbRed Then
                ' 复制当前整行
                Cell.EntireRow.Copy
                ' 仅粘贴值到目标区域（不复制格式）
                copyRange.Offset(i, 0).PasteSpecial xlValues
                ' 更新偏移量，准备下一行粘贴
                i = i + 1
                ' 找到红色单元格后跳出当前行循环，避免重复复制
                Exit For
            End If
        
        Next Cell

Next startOfRowCell

End Sub

核心要点说明 #

• 适配条件格式的颜色检测：必须使用DisplayFormat.Interior.Color获取单元格实际显示的颜色，直接调用Interior.Color只能读取手动设置的背景色，无法识别条件格式生成的颜色。
• 高效循环逻辑：外层循环遍历所有数据行，内层循环检查该行的每个单元格；一旦找到红色单元格就复制整行并跳出内层循环，避免同一行被多次复制。
• 动态目标定位：用变量i记录目标区域的下一个空行位置，每次粘贴后自增偏移量，确保新行自动追加到目标区域末尾。
• 自动范围识别：通过End(xlDown)和End(xlToRight)自动获取源数据的有效范围，无需手动指定固定的行/列数，适配数据量变化。

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