Private Sub Worksheet_Activate()
Dim dest As Range, d As Object, tablo, i&, ncol%, flag As Boolean, j%, n%
Set dest = [A1] '1ère cellule de destination, à adapter
'---liste sans doublon---
Set d = CreateObject("Scripting.Dictionary")
tablo = Feuil1.UsedRange.Columns(1).Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
d("") = "" 'pour inclure les vides
For i = 1 To UBound(tablo)
d(tablo(i, 1)) = ""
Next
'---tableau des résultats---
With Feuil2.UsedRange
ncol = .Columns.Count
If ncol = 1 Then ncol = 2 'pour avoir au moins 2 éléments
tablo = .Resize(, ncol)
End With
Application.ScreenUpdating = False
Cells.Interior.ColorIndex = xlNone 'RAZ
For i = 1 To UBound(tablo)
If tablo(i, 1) <> "" Then
flag = False
For j = 2 To ncol
If Not d.exists(tablo(i, j)) Then flag = True: dest(i, j).Interior.ColorIndex = 44 'couleur de fond orange
Next j
If flag Then
n = n + 1
For j = 1 To ncol
tablo(n, j) = tablo(i, j)
Next j
End If
End If
Next i
'---restitution---
If FilterMode Then ShowAllData 'si la feuille est fimtrée
With dest
If n Then .Resize(n, ncol) = tablo
.Offset(n).Resize(.Parent.Rows.Count - n - .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