Máximos colaboradores

Prueba esta macro, vale para cualquier cantidad de filas/columnas. Const Naranja As Long = 6403322 Const Morado As Long = 11423218 Const Verde As Long = 4896057 Const Rojo As Long = 6709491 '-- Sub Resaltes() Dim Sales As Range, Fcst As Range Application.ScreenUpdating = False '-- For x = 2 To Range("A" & Rows.Count).End(xlUp).Row Step 2 For y = 4 To Cells(1, Columns.Count).End(xlToLeft).Column '-- Set Fcst = Cells(x, y) Set Sales = Cells(x, y).Offset(1) '-- Sales.Interior.ColorIndex = xlNone Fcst.Interior.ColorIndex = xlNone '-- If Sales <> "" Then If Round(Sales) = 0 And Round(Fcst) > 0 Then Sales.Interior.Color = Rojo Fcst.Interior.Color = Rojo End If '-- If Round(Sales) <> 0 And Round(Sales) < Round(Fcst) Then Sales.Interior.Color = Naranja Fcst.Interior.Color = Naranja End If '-- If Round(Sales) = Round(Fcst) Then Sales.Interior.Color = Verde Fcst.Interior.Color = Verde End If '-- If Round(Sales) <> 0 And Round(Fcst) < Round(Sales) Then Sales.Interior.Color = Morado Fcst.Interior.Color = Morado End If '-- End If Next Next End Sub