Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Compteur As Integer
Dim CellCible As Range
On Error Resume Next
Compteur = [CompteurFeuille] + 1 ' évalue et incrémente le compteur
If Err.Number <> 0 Then Compteur = 1: Names.Add Name:="CompteurFeuille", RefersTo:=Compteur 'si pas trouvé, le crée
On Error GoTo 0
If Not Intersect(Target, Columns(1)) Is Nothing Then
Set CellCible = Cells(Range("A65000").End(xlUp).Row + 1, Target.Column)
CellCible = "COUR" & Compteur 'écrit la clé dans la colonne 1
CellCible.Offset(0, 1) = Now ' 'écrit la date dans la colonne 2
CellCible.Offset(0, 2).Activate ' active la colonne 3 pour faire la saisie
Names.Add Name:="CompteurFeuille", RefersTo:=Compteur 'met à jour le compteur
End If
End Sub