Private Sub Worksheet_Activate()
Dim d As Object, tablo, i&, x$, nlig&, ncol%, resu(), j%, n%
'---liste sans doublon---
Set d = CreateObject("Scripting.Dictionary")
tablo = Feuil1.UsedRange.Columns(1).Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
For i = 1 To UBound(tablo)
x = tablo(i, 1)
If x <> "" Then d(x) = ""
Next
'---tableau des résultats---
With Feuil2.UsedRange
nlig = .Rows.Count
ncol = .Columns.Count
If ncol = 1 Then ncol = 2 'pour avoir au moins 2 éléments
tablo = .Resize(, ncol)
End With
ReDim resu(1 To nlig, 1 To ncol)
For i = 1 To nlig
resu(i, 1) = tablo(i, 1): n = 1
For j = 2 To ncol
If d.exists(tablo(i, j)) Then n = n + 1: resu(i, n) = tablo(i, j)
Next j, i
'---restitution---
If FilterMode Then ShowAllData 'si la feuille est fimtrée
With [A1] '1ère cellule de restitution, à adapter
.Resize(nlig, ncol) = resu
.Offset(nlig).Resize(.Parent.Rows.Count - nlig - .Row + 1).EntireRow.ClearContents 'RAZ en dessous
.Offset(, ncol).Resize(, .Parent.Columns.Count - ncol - .Column + 1).EntireColumn.ClearContents 'RAZ à droite
End With
With UsedRange: End With 'actualise les barres de défilement
End Sub