H o l a : Te anexo la macro
Sub PintarValores()
'Por.Dante Amor
Application.ScreenUpdating = False
cols = Array("A", "B") 'columnas a pintar
col = "Z" 'columna auxiliar
'
For k = LBound(cols) To UBound(cols)
Columns(cols(k)).Interior.ColorIndex = xlNone
Columns(cols(k)).Copy Range(col & "1")
u = Range(col & Rows.Count).End(xlUp).Row
ActiveSheet.Range(col & "1:" & col & u).RemoveDuplicates Columns:=1, Header:=xlNo
wcolor = 3
Set r = Columns(cols(k))
For i = 1 To Cells(Rows.Count, col).End(xlUp).Row
If Cells(i, col) <> "" Then
Set b = r.Find(Cells(i, col), lookat:=xlWhole)
If Not b Is Nothing Then
celda = b.Address
Do
b.Interior.ColorIndex = wcolor
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> celda
End If
wcolor = wcolor + 1
End If
Next
Next
Application.ScreenUpdating = True
MsgBox "Fin"
End Sub
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias