Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
Dim txt$, i As Integer, trad As Variant
txt = Application.Trim(Target)
For i = 0 To UBound(Split(txt, " "))
trad = Application.VLookup(Split(txt, " ")(i), Sheets("dico").Range("A:B"), 2, 0)
If Not IsError(trad) Then txt = Replace(txt, Split(txt, " ")(i), trad)
Next
Application.EnableEvents = False
Target = txt
Application.EnableEvents = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Set Target = Intersect(Target, UsedRange)
If Target Is Nothing Then Exit Sub
Dim d As Object, tablo, i&, txt$, s
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
tablo = Sheets("dico").[A1].CurrentRegion.Resize(, 2) 'matrice, plus rapide
For i = 1 To UBound(tablo)
d(tablo(i, 1)) = tablo(i, 2)
Next i
Application.ScreenUpdating = False
Application.EnableEvents = False
For Each Target In Target 'si entrées multiples (copier-coller)
txt = Trim(Target)
s = Split(txt)
For i = 0 To UBound(s)
If d.exists(s(i)) Then s(i) = d(s(i)) 'traduction
Next i
Target = Join(s)
Next Target
Application.EnableEvents = True
End Sub