Sub DuplicatesColoring()   
    Dim dupes()     'объявляем массив для хранения дубликатов
    ReDim dupes(1 To Selection.Cells.Count, 1 To 2)
     
    Selection.Interior.ColorIndex = -4142   'убираем заливку если была
    i = 3
    For Each cell In Selection
        If WorksheetFunction.CountIf(Selection, cell.Value) > 1 Then
            For k = LBound(dupes) To UBound(dupes)
                'если ячейка уже есть в массиве дубликатов - заливаем
                If dupes(k, 1) = cell Then cell.Interior.ColorIndex = dupes(k, 2)
            Next k
            'если ячейка содержит дубликат, но еще не в массиве - добавляем ее в массив и заливаем
            If cell.Interior.ColorIndex = -4142 Then
                cell.Interior.ColorIndex = i
                dupes(i, 1) = cell.Value
                dupes(i, 2) = i
                i = i + 1
            End If
        End If
    Next cell
End Sub