Private Sub Worksheet_Activate()
Dim i As Long, d As Object
With Sheets("base")
Set d = CreateObject("Scripting.Dictionary")
For i = 4 To 14
d(.Cells(i, "H").Value) = .Cells(i, "H").Interior.Color
Next i
For i = 3 To .[e65000].End(xlUp).Row
If Not d.exists(.Cells(i, 5).Value) Then
.Range(.Cells(i, 1), .Cells(i, 5)).Interior.Color = xlNone
Else:
.Range(.Cells(i, 1), .Cells(i, 5)).Interior.Color = d(.Cells(i, 5).Value)
End If
Next i
End With
End Sub