Sub Dikaya()
    ThisWorkbook.Activate
    Application.ScreenUpdating = False
    Dim lr As Long
    Dim lC As Long
    Dim i As Long
    Worksheets("Лист1").Activate
For i = 2 To Worksheets("Лист1").Cells(Rows.Count, 2).End(xlUp).Row
    Worksheets("Лист2").Activate
For lC = 2 To Worksheets("Лист2").Cells(2, Columns.Count).End(xlToLeft).Column
For lr = 3 To Cells(Rows.Count, lC).End(xlUp).Row
   If Worksheets("Лист2").Cells(lr, lC).Value = Worksheets("Лист1").Cells(i, 2).Value Then
      Worksheets("Лист1").Cells(i, 2).Interior.Color = Worksheets("Лист2").Cells(2, lC).Interior.Color
   End If
Next lr
Next lC
Next i
     Worksheets("Лист1").Activate
     Application.ScreenUpdating = True
End Sub