如果单元格在excel中具有红色/绿色/黄色，则复制粘贴整行

Question

我有一个表，其中包含基于月度和产品的值，如下所示（例如“sheet1”）。此表应用了条件格式以根据目标突出显示单元格颜色红色/黄色/绿色。因此，我只想获取特定月份（当前月份 - 5 月）列，并希望 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中上个月的所有行，这些行可能在上个月突出显示，但在本月没有突出显示。

我尝试了不同的方法来做到这一点，它无法识别单元格颜色。当我使用表格中的随机/常规单元格并填充红色并使用 find(ctrl+f) 弹出框使用颜色格式突出显示时，它正在工作，但它不采用表格中具有条件格式的单元格。所以，我不知道是否有办法识别表格中使用 VBA 以红色突出显示的所有单元格。

Answer 1

输入（在工作表 1 中）：

输出（在工作表 2 中）：

    Sub newnew()

声明工作表，应更改 Sheet2 和 Sheet3 以匹配您的工作表名称

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

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

清除 wsTwo 中以前的数据

    wsTwo.Cells.Clear

找到 ws 的最后一行和最后一列，里面有数据

    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

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

     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