vba - Excel 将工作表 1 和 2 中突出显示/黄色的所有值复制到工作表 3

Question

我有一个带有 3 张工作表的 Excel 工作簿，前两张包含大量数据，第三张是空白的。

我想创建一个宏，从表 1 和 2 中复制所有突出显示/黄色的单元格并将它们粘贴到表 3 中。

我在宏中有一些代码，目前只是将工作表 1 复制到工作表 3，但即使我使用了 If .Interior.ColorIndex，它也会复制所有内容

Sub Yellow()
Dim LR As Long, i As Long, j As Long
j = 1
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To LR
    With Worksheets("Sheet1").Range("A1:CF200" & i)
       If .Interior.ColorIndex Like 27 Or 12 Or 36 Or 40 Or 44 Then
            .Copy Destination:=Worksheets("Sheet3").Range("J" & j)
            j = j + 1
        End If
    End With
Next i
End Sub

Answer 1

更新:下面的代码修改为跳过黄色突出显示的空白单元格...

我可能会将它分为两​​个部分，一个循环遍历工作表的脚本和一个检查单元格 (Range) 是否为黄色的函数。下面的代码有很多注释，这些注释贯穿了这些步骤:

Option Explicit
Sub PutYellowsOnSheet3()

Dim Sh As Worksheet, Output As Worksheet
Dim LastRow As Long, LastCol As Long
Dim Target As Range, Cell As Range, Dest As Range
Dim DestCounter As Long

'initialize destination counter and set references
DestCounter = 1
Set Output = ThisWorkbook.Worksheets("Sheet3")

'loop through sheets that are not named "Sheet3"
For Each Sh In ThisWorkbook.Worksheets
    If Sh.Name <> "Sheet3" Then
        With Sh
            LastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            LastCol = .Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
            Set Target = .Range(.Cells(1, 1), .Cells(LastRow, LastCol))
        End With
        For Each Cell In Target '<~ loop through each cell in the target space
            If AmIYellow(Cell) And Cell.Value <> "" Then '<~ blank check too
                Set Dest = Output.Cells(DestCounter, 1)
                Cell.Copy Dest
                DestCounter = DestCounter + 1 '<~ keep incrementing on sheet 3
            End If
        Next Cell
    End If
Next Sh

End Sub

'call this function when you'd like to check if a range is yellow
Public Function AmIYellow(Cell As Range) As Boolean
    If Cell Is Nothing Then
        AmIYellow = False
    End If
    Select Case Cell.Interior.ColorIndex '<~ this is the yellow check
        Case 27, 12, 36, 40, 44
            AmIYellow = True
        Case Else
            AmIYellow = False
    End Select
End Function