Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, n&, a$(), x$, y$
Set r = Intersect(Target, [C:C], Me.UsedRange)
If r Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each r In r 'si entrées multiple (copier-coller)
n = n + 1
ReDim Preserve a(1 To 2, 1 To n)
x = CStr(r.Value2)
If IsNumeric(x) Then
y = Format(x, "#0\/00\/0000")
If (x Like "#######" Or x Like "########") And IsDate(y) Then
a(1, n) = r.Address
a(2, n) = Format(y, "m/d/yyyy")
Else
Application.Undo 'annulation
GoTo 1
End If
End If
Next
For n = 1 To UBound(a, 2)
If a(1, n) <> "" Then
With Range(a(1, n))
.Value = a(2, n)
If Not IsNumeric(.Value2) Then .Value = "" 'autre cas d'annulation
End With
End If
Next
1 [C:C].NumberFormat = "dd/mm/yyyy" 'format modifiable
Application.EnableEvents = True
End Sub