Quote Originally Posted by footoo View Post
Code:
Dim cel As Range, rw%, c%, x%
[C5:J5].Copy [M5]
[C5:J5].Copy Sheets("Sheet2").[C5]
[M6:T3209].ClearContents
[M6:M3209].Interior.Pattern = xlNone
Sheets("Sheet2").[C6:J3209].ClearContents
Sheets("Sheet2").[C6:C3209].Interior.Pattern = xlNone
If WorksheetFunction.CountA([D1:J3]) = 0 Then Exit Sub
On Error Resume Next
For rw = 1 To 3
    For Each cel In Cells(rw, "D").Resize(, 7).SpecialCells(xlCellTypeConstants)
        With [C5:C3209].Find(cel, LookAt:=xlWhole).Resize(9, 8)
            .Copy Cells(Rows.Count, "M").End(3)(2)
            .Copy Sheets("Sheet2").Cells(Rows.Count, "C").End(3)(2)
        End With
    Next
Next
For c = 6 To Cells(Rows.Count, "M").End(3).Row Step 9
    If x = 0 Then
        Cells(c, "M").Resize(9).Interior.ColorIndex = 6
        Sheets("Sheet2").Cells(c, "C").Resize(9).Interior.ColorIndex = 6
        x = 1
    Else
        Cells(c, "M").Resize(9).Interior.ColorIndex = 38
        Sheets("Sheet2").Cells(c, "C").Resize(9).Interior.ColorIndex = 38
        x = 0
    End If
Next
On Error GoTo 0
Wow footoo, this is very good idea now it is looking clearer, separately group wise. Thanks a lot for your time you spent to solve full query in a nice way.

Have a good day


Kind Regards,

Moti