Macro ajouter texte dans une cellule

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
    Cancel As Boolean)
Dim Text As String
    With Target
        If .Cells.Count > 1 Then Exit Sub
        Text = .Value
        .Value = Text & "  " & Date
        Cancel = True  
    End With
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Not Application.Intersect(Target, Range([A3].End(xlDown)) Is Nothing Then GoTo Action1
If Not Application.Intersect(Target, Range([C5].End(xlDown)) Is Nothing Then GoTo Action2

Action1:
Dim Text As String
    With Target
        If .Cells.Count > 1 Then Exit Sub
        Text = .Value
        .Value = Text & Chr(10) & Date
        Cancel = True
    End With

Action2:
Dim Text As String
    With Target
        If .Cells.Count > 1 Then Exit Sub
        Text = .Value
        .Value = Text & Chr(10) & "OK" & Date
        Cancel = True
    End With

End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Count = 1 Then
    If Not Intersect(Target, Range("A3:A" & Range("A3").End(xlDown).Row, "C5:C" & Range("C5").End(xlDown).Row)) Is Nothing Then
        With Target
            .Value = .Value & Chr(10) & Date
            Cancel = True
        End With
    End If
End If
End Sub