Ajout et supp de données par proc événementielle

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 18 Or Target.Cells.Count > 1 Then Exit Sub
Dim lig, temp As Long
lig = 0
On Error Resume Next
lig = Application.Match(Target.Offset(0, -17), Sheets("Donnees").Range("A:A"), 0)
If IsDate(Target) And lig = 0 Then
    temp = Application.CountA(Sheets("Donnees").Range("A:A")) + 1
    Sheets("Donnees").Cells(temp, 1) = Target.Offset(0, -17)
End If
If lig Then
    With Sheets("Donnees").Cells(lig, 1)
        If Target = "" And .Offset(0, 1) <> "Envoyé" Then .EntireRow.Delete
    End With
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("R4:R10000")) Is Nothing Then Exit Sub
Application.EnableEvents = False [COLOR="Red"]'désactive l'action des évènements[/COLOR]
On Error Resume Next [COLOR="Red"]'contrôle d'erreur[/COLOR]
If Target.Cells.Count > 1 Then Application.Undo: GoTo 1 [COLOR="Red"]'annule si plusieurs cellules modifiées simultanément[/COLOR]
Dim lig As Long
lig = 0
With Sheets("Donnees")
lig = Application.Match(Target.Offset(0, -17), .Range("A:A"), 0)
[COLOR="Red"]'pour l'entrée d'une donnée[/COLOR]
If lig = 0 Then
  If Target <> "" And Not IsDate(Target) Then Application.Undo: GoTo 1 [COLOR="Red"]'annule l'entrée si ce n'est pas une date[/COLOR]
  .Cells(Application.CountA(.Range("A:A")) + 1, 1) = Target.Offset(0, -17) [COLOR="Red"]'écriture en feuille Donnes[/COLOR]
  .Range("A:B").Sort Key1:=.Range("A1"), Order1:=xlAscending [COLOR="Red"]'tri ascendant feuille Donnees[/COLOR]
End If
[COLOR="Red"]'pour l'effacement[/COLOR]
If Target = "" And .Cells(lig, 1).Offset(0, 1) <> "Envoyé" Then .Rows(lig).Delete [COLOR="Red"]'supprime la ligne[/COLOR]
End With
1 Application.EnableEvents = True [COLOR="Red"]'réactive l'action des évènements[/COLOR]
End Sub