Private Sub Worksheet_Change(ByVal Target As Range)
Dim tablo, d As Object, i&, x$, y$, a
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A1].CurrentRegion
If Intersect(Target, .Columns("B:C").Offset(1)) Is Nothing Then Exit Sub
tablo = .Resize(, 3) 'matrice, plus rapide
Set d = CreateObject("Scripting.Dictionary")
'---liste de correspondance sans doublons---
For i = 1 To UBound(tablo) - 1
x = UCase(Application.Trim(tablo(i, 2))): y = UCase(Application.Trim(tablo(i, 3)))
If Not d.exists(x) And y <> "" Then d(x) = y
Next i
'---traitement des entrées en colonnes B et C---
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
Set Target = Intersect(.Columns("B:C").Offset(1), Target.EntireRow)
For Each a In Target.Areas 'si entrées/suppressions multiples (copier-coller)
tablo = a 'matrice, plus rapide
For i = 1 To UBound(tablo)
tablo(i, 1) = UCase(Application.Trim(tablo(i, 1))) 'contrôle
tablo(i, 2) = d(tablo(i, 1)) 'correspondance si elle existe
Next i
a.Value = tablo 'restitution
Next a
Application.EnableEvents = True 'réactive les évènements
End With
End Sub