Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Variant
If Not Intersect(Target, Range("A4:B" & Rows.Count)) Is Nothing _
Then Worksheet_Change [D:D]: Exit Sub 'relance la macro
i = [D:E].Find("*", , xlValues, , xlByRows, xlPrevious).Row
If i < 4 Then Exit Sub
Set Target = Intersect(Target, Range("D4:D" & i))
If Target Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False
For Each Target In Target 'si entrées/effacements multiples
i = Application.Match(Target, Range("B4:B" & Rows.Count), 0)
If IsNumeric(i) Then
If Target(1, 2) <> Cells(i + 3, 1) Then Target(1, 2) = Cells(i + 3, 1)
ElseIf Target(1, 2) <> "" Then
Target(1, 2) = ""
End If
Next
Application.EnableEvents = True
End Sub