Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$1" Then
Application.EnableEvents = False
If Target = "" Or Not IsDate(Target.Value) Then Target = "": Exit Sub
If WorksheetFunction.CountBlank([A2:A10]) = 0 Then [A2:A10].ClearContents
Cells(11, 1).End(xlUp).Offset(1) = [d1]
End If
Application.EnableEvents = True
End Sub