Excel скопирует все значения из листов 1 и 2, которые выделены / желтые на лист 3

Question

У меня есть книга Excel с 3 листами, первые два содержат много данных, а третий пустой.

Я хочу создать макрос, который копирует все выделенные / желтые ячейки из листов 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

Answer 2

Ваше состояние
.Interior.ColorIndex Like 27 Or 12 Or 36 Or 40 Or 44

всегда оценивается как Истина (любое число, кроме 0, Истина), так что на самом деле ваше условие:
'condition' Or True Or True ...
должно быть:

  `.Interior.ColorIndex Like 27 _ 
  Or .Interior.ColorIndex Like 12 _
  Or .Interior.ColorIndex Like 36 _
  Or .Interior.ColorIndex Like 40 _
  Or .Interior.ColorIndex Like 44`

или лучше переписать как:

Select Case .Interior.ColorIndex
    case 27,12,36,40,44
        'action
    Case Else
        'do nothing
End Select

Answer 3

В вашем сценарии есть несколько ошибок. Я думаю, что вы хотите зациклить все ячейки в данном диапазоне и скопировать только те ячейки, которые имеют указанные цвета. Это можно сделать так:

Sub jzz()
Dim LR As Long, i As Long, j As Long
Dim c As Range
j = 1
LR = Range("A" & Rows.Count).End(xlUp).Row
For Each c In Worksheets("Blad1").Range("A1:G" & LR)
      If c.Interior.ColorIndex = 6 Then
            c.Copy Destination:=Worksheets("Blad2").Range("A" & j)
            j = j + 1
        End If
Next c
End Sub

Вам нужно будет немного изменить код, например, "Blad1" не будет существовать в вашей книге, и я взял только ColorIndex = 6