Function getRGB1(FCell As Range) As String 
    Dim xColor As String 
    xColor = CStr(FCell.Interior.Color) 
    xColor = Right("000000" & Hex(xColor), 6) 
    getRGB1 = Right(xColor, 2) & Mid(xColor, 3, 2) & Left(xColor, 2) 
End Function 
 
' Определение количества залитых ячеек определённым цветом 
Public Function СУММ_RGB(Mass As Range, kontrol As Range) As Integer 
' Mass - контролируемый массив 
' kontrol - ячейка с цветом которой сравнивается. 
СУММ_RGB = 0 
        For i = 1 To Mass.Count 
            If getRGB1(Mass.Rows(i)) = getRGB1(kontrol.Rows(1)) Then 
                СУММ_RGB = СУММ_RGB + 1 
            End If 
        Next i 
End Function 

Sub Test()
Dim ArrayToFind As Variant, iItem As Variant, Rng As Range, Sht1 As Worksheet, Sht2 As Worksheet, LastRow As Long

    'запоминаем названия листов в переменные
    Set Sht1 = Worksheets("Лист1")
    Set Sht2 = Worksheets("Лист2")
    
    'очищаем Лист2
    Sht2.UsedRange.Clear
    
    'перечисляем значения для поиска
    ArrayToFind = Array("ФГ", "ФО", "ФЯ 50-я рейка", "ФР", "ФОР", "ФГР")
    
    For Each iItem In ArrayToFind
        'поиск каждого значения на Лист1 в столбцах В:C
        Set Rng = Sht1.Columns("B:C").Find(iItem, , xlFormulas, xlWhole)
        'если нашли
        If Not Rng Is Nothing Then
            'записываем на Лист2
            With Sht2
                LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
                .Cells(LastRow, 1) = iItem 'Наименование изделия
                .Cells(LastRow, 2) = Rng.Offset(0, 1) 'длина
                .Cells(LastRow, 3) = Rng.Offset(0, 2) 'ширина
            End With
        End If
    Next iItem
    MsgBox "Данные скопированы!", vbInformation, "Конец"
End Sub