Sub ColorierDoublons()
Dim cc%, i&
Application.ScreenUpdating = False
With [A1].CurrentRegion
cc = .Columns.Count
.EntireColumn.Interior.ColorIndex = xlNone 'RAZ
'---entrée des formules dans un 2ème tableau---
.Cells(1).Offset(, cc) = "=LN(COUNTIF(" & .Rows(1).Address(0, 1) & ",A1)>1)"
.Cells(1).Offset(, cc).Copy .Offset(, cc)
'---copie les formats du 1er tableau sur le 2ème---
.Copy
.Offset(, cc).PasteSpecial xlPasteFormats
'---itérations par pas de 500 lignes---
On Error Resume Next
For i = 0 To .Rows.Count - 1 Step 500
'---colorie le 2ème tableau---
.Offset(i, cc).Resize(500).SpecialCells(xlCellTypeFormulas, 1) _
.Interior.ColorIndex = 6 'jaune
'---copie les formats du 2ème tableau sur le 1er---
.Offset(i, cc).Resize(500).Copy
.Offset(i).Resize(500).PasteSpecial xlPasteFormats
Next
'---supprime le 2ème tableau---
.Offset(, cc).EntireColumn.Delete
'---mise à jour de la barre de défilement verticale---
.Offset(.Rows.Count).Resize(500).Delete xlUp
.Parent.UsedRange.Select
.Cells(1).Select
End With
End Sub