Vba 如果excel中的单元格颜色为红色/绿色/黄色，则复制粘贴整行

我有一个表，表中的值以每月为基础，第1列为产品，如下所示（如“sheet1”）。此表具有应用于根据目标突出显示单元格颜色红/黄/绿的条件格式。因此，我只想选取特定月份（当前月份-五月）列，并希望VBA检查，如果该列中的任何单元格为红色，则选择整行并将其复制到另一个表格中，例如带有标题的“Sheet2”

Product   =  Target   Feb Mar Apr May
Wood     >=    5      10  10  10  10
wood     >=    5      28  28  28  28
Tree     >=   12      30  45  60  68
plastic  >=   45      50  50  50  50
tree     >=   50      50  50  50  50
iron     >=   100     64  75  75  80

值将每月更改，有时甚至更改为目标值，因此颜色有时可能完全为绿色/黄色/红色。所以，我想用VBA自动化这个过程，每个月去检查“Sheet1”，并提取当月突出显示红细胞的任何行。甚至一个按钮功能也会有帮助，所以我可以将这个宏分配给一个按钮，这个操作应该通过点击按钮来完成。甚至它也应该清除Sheet2中上个月的所有行，这些行可能在上个月突出显示，但在本月不突出显示

我试过，不同的方法来做这件事，它不能识别细胞的颜色。当我使用表外的随机/常规单元格，用红色填充，并使用“查找”（ctrl+f）弹出框突出显示“使用颜色格式”时，它工作正常，但不使用表中具有条件格式的单元格。因此，我不知道是否有办法使用VBA识别表格中以红色突出显示的所有单元格。

输入（在工作表1中）：

输出（在工作表2中）：

声明工作表、工作表2和工作表3时应进行更改，以匹配工作表名称

清除wsTwo中以前的数据

查找包含数据的ws的最后一行和最后一列

我们正在这里设置标题

从最后一排开始循环，向上移动，直到到达第2排。我们正在检查rowNum和lastColumn显示格式内部颜色是否为红色。如果是，我们将获取该范围，复制它，然后将其粘贴到wsTwo中。请注意，我们在进入for循环之前设置了行计数器。我们将使用它作为占位符，每次粘贴到ws-two中时都会递增，这样我们就不会粘贴到刚刚粘贴的数据上

---

这个答案应该为你指明方向@我不认为这个答案对这个问题有帮助。这里有几个选项：检查原始条件逻辑是否满足；使用辅助列；或者检查单元格的

DisplayFormat.Interior.Color

。另一个选项：使用带有

运算符的
AutoFilter
（对于列）：=xlFilterCellColor

）一次移动所有行您是否已经为此做了任何工作？请重新阅读问题，他只希望检查当前月份的列的单元格颜色，而不是数据范围中的所有单元格，硬编码列将不起作用，因为最后一列将每月更改。此外，插入将翻转行，因此最后一行将位于第一行。对于sheet2，粘贴和最后一行+1可能是最佳选择。您可能想编辑您的答案。@GMalc您完全正确，根据您的输入进行了修正（由于某些原因，我发现您的描述比OP更清晰）。编辑以改进答案。t谢谢你的时间和代码，但是，我可以使用“查找”弹出框，甚至使用你的代码来做同样的事情，但正如我在问题中提到的，当使用条件格式在背景中应用此颜色时，它不会识别红细胞/颜色。这只有在我手动填充每个单元格的颜色时才起作用。因此，如果您能根据此要求编辑代码，我将不胜感激。一切都按照我的需要工作，除了通过条件格式应用时没有标识颜色，甚至在复制到sheet2时我也需要标题。即使如此，我已经编辑了我的表，其中运算符位于单独的列中。我在这里做的是，我使用下面的公式“evaluate（concatenate（sheet1！D2，sheet1！$C2，sheet1！$D2））创建一个名称管理器（Comparetotarget），它将单元格中的值计算为“10>=5”，并应用于D2:F7中的所有单元格。然后使用“if（not（Comparetotarget），if（ABS）”在该单元格顶部应用条件格式(（D2-$C2/$C2）>5%，为“True”）“如果我将check color语句切换为，单元格将变为红色（rowNum，lastColumn）。DisplayFormat.INTERROR.color=vbRed。请确保将条件着色设置为vb red，颜色与我的照片中的颜色相同。这应该可以。请告诉我。

    Sub newnew()

    Dim ws As Worksheet
        Set ws = Sheets("Sheet2")

    Dim wsTwo As Worksheet
       Set wsTwo = Sheets("Sheet3")

    wsTwo.Cells.Clear

    Dim lastRow As Integer
        lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

    Dim lastColumn As Integer
        lastColumn = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column

    ws.Range("A1:F1").Copy
    wsTwo.Range("A1:F1").PasteSpecial xlPasteAll
    Application.CutCopyMode = False

     Dim rowCounterWsTwo As Integer
         rowCounterWsTwo = 2

    For rowNum = lastRow To 2 Step -1
            If Cells(rowNum, lastColumn).DisplayFormat.Interior.Color = vbRed = vbRed Then
                ws.Range(Cells(rowNum, 1), Cells(rowNum, lastColumn)).Copy
                wsTwo.Range("A2:F2").Insert
                Application.CutCopyMode = False
                rowCounterWsTwo = rowCounterWsTwo + 1
            End If
    Next rowNum

End Sub