Figer les dates sans écrasé l'ancienne figé

[anthoYS]

Bonjour,

Voir le fichier avec ce qui est attendu sur le second onglet.

Dans l'exemple le premier double clic est réalisé en B18 le 04/07, le second en B31 le 15/07.

Merci par avance.

 

[Efgé]

Re : Figer les dates sans écrasé l'ancienne figé

Re anthoYS,
Une proposition à mettre dans le code de la feuille 1

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("B2:B" & Range("A" & Application.Rows.Count).End(xlUp).Row)) Is Nothing Then
Application.ScreenUpdating = False
Cancel = True
For i = Target.End(xlUp).Row + 1 To Target.Row
    Cells(i, 2) = Date
Next i
Application.ScreenUpdating = True
End If
End Sub

Il y a surement plus rapide, j'attend d'autres propositions pour voir 😉
Cordialement

 

[anthoYS]

Re : Figer les dates sans écrasé l'ancienne figé

Parfait Efgé.

Un grand merci à toi.

 

[job75]

Re : Figer les dates sans écrasé l'ancienne figé

Bonjour anthoYS, Efgé,

Une autre solution :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim ref As Range
Set ref = Range("B65536").End(xlUp)(2)
If Target.Row < ref.Row Then Exit Sub
Cancel = True
Range(ref, Cells(Target.Row, "B")) = Date
End Sub

Edit : j'avais d'abord utilisé (inutilement) FillDown !!

A+

 

[anthoYS]

Re : Figer les dates sans écrasé l'ancienne figé

Merci job75.