Private Sub Worksheet_Change(ByVal Target As Range)
Dim ncol%, tablo, ref, dest As Range, d As Object, i&, n&, j%
With [B2].CurrentRegion 'à adapter
ncol = IIf(.Count = 1, 2, .Columns.Count)
tablo = .Resize(, ncol) 'matrice, plus rapide, au moins 2 éléments
End With
ref = [G3:G6].Resize(, 2) 'colonne à adapter, au moins 2 cellules
Set dest = [I3] '1ère cellule de destination, à adapter
Set d = CreateObject("Scripting.Dictionary")
'---mémorisation des références---
For i = 1 To UBound(ref)
d(ref(i, 1)) = ""
Next i
'---analyse du tableau source---
For i = 2 To UBound(tablo)
If d.exists(tablo(i, 1)) Then
n = n + 1
For j = 1 To ncol
tablo(n, j) = tablo(i, j)
Next j
End If
Next i
'---restitution---
Application.EnableEvents = False 'désactive les évènements
If FilterMode Then ShowAllData 'si la feuille est filtrée
If n Then
With dest.Resize(n, ncol)
.Value = tablo
.Interior.ColorIndex = 6 'jaune
.Borders.Weight = xlHairline 'bordures
End With
End If
dest.Offset(n).Resize(Rows.Count - n - dest.Row + 1, ncol).Delete xlUp 'RAZ en dessous
Application.EnableEvents = True 'réactive les évènements
End Sub