Private Sub Worksheet_Change(ByVal Target As Range)
Dim derlig&, r As Range, adresse$, c As Range, mem$(), i&
derlig = [E:F].Find("*", , xlValues, , xlByRows, xlPrevious).Row
Set r = Intersect(Target, Range("E2:F" & derlig))
If derlig < 2 Or r Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les événements
On Error Resume Next
ReDim mem(1 To r.Count)
Application.Undo 'annule l'entrée
adresse = r.Address
For Each c In r 'si plusieurs cellules sont modifiées
i = i + 1
mem(i) = CStr(c) 'mémorisation
Next
Application.Undo 'restitue l'entrée
If adresse <> r.Address Then GoTo 1 'si insertion/suppression de ligne
i = 0
For Each c In r
i = i + 1
If CStr(c) <> "" Then
If InStr(mem(i), CStr(c)) Then
mem(i) = Replace(mem(i), CStr(c) & vbLf, "")
mem(i) = Replace(mem(i), vbLf & CStr(c), "")
mem(i) = Replace(mem(i), CStr(c), "")
Else
mem(i) = mem(i) & IIf(mem(i) = "", "", vbLf) & CStr(c)
End If
c = mem(i)
End If
Next
1 Application.EnableEvents = True 'réactive les événements
Application.ScreenUpdating = True
End Sub