Microsoft 365 rechercher doublons horizontalement

=SIERREUR(INDEX($B1:F1;PETITE.VALEUR(SI(NON(NB.SI($I1:I1;$B1:$F1));COLONNE($B1:$F1)-1);1));"")

Sub Copier()
Dim t
t = Timer
Rows(1).AutoFill Rows(1).Resize(180000), xlFillValues
MsgBox Timer - t
End Sub

Sub Doublons()
Dim ncol%, R As Range, t, tablo, ub%, resu(), d As Object, i&, n%, j%, x
ncol = 5 'nombre maximum de colonnes des résultats, à adapter
Set R = [B1:F180000] 'à adapter
'---initialisation---
R = "=RANDBETWEEN(1," & ncol & ")" 'ALEA.ENTRE.BORNES
R = R.Value 'supprime les formules
'---traitement des doublons---
t = Timer
tablo = R 'matrice, plus rapide
ub = UBound(tablo, 2)
ReDim resu(1 To UBound(tablo), 1 To ncol)
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(tablo)
    d.RemoveAll 'RAZ
    n = 0
    For j = 1 To ub
        x = tablo(i, j)
        If Not d.exists(x) Then d(x) = "": n = n + 1: resu(i, n) = x
Next j, i
'---restitution---
With [I1] '1ère cellule de restitution, à adapter
    .Resize(i - 1, ncol) = resu
    .Offset(i - 1).Resize(Rows.Count - i - .Row + 2, ncol).ClearContents 'RAZ en dessous
End With
MsgBox Format(i - 1, "#,##0") & " lignes traitées en " & Format(Timer - t, "0.0 \sec"), , "Doublons"
End Sub