Private Sub Worksheet_Change(ByVal Target As Range) Dim WatchRange As Range
Dim IntersectRange As Range
' Si sélection de plusieurs ligne on sort, sinon bug avec Target.Value
If Target.Count > 1 Then Exit Sub
' Tester s'il s'agit d'un effacement
If Target.Value = "" Then Exit Sub
'
Set WatchRange = Range("C4:M33")
Set IntersectRange = Intersect(Target, WatchRange)
If IntersectRange Is Nothing Then
'on ne fait rien si pas de changement
Else
'ici commence si changement detecté
' Empêcher les évènements car on modifie la cellule
' => risque de boucle infinie
Application.EnableEvents = False
'
Numero_ligne = ActiveCell.Row
Worksheets("Feuil4").Range("O" & Numero_ligne).Value = Date
' Activer de nouveau les évènements
Application.EnableEvents = True
End If
End Sub