Formule date la plus proche

Private Sub Workbook_Open()
Dim i As Variant
Application.ScreenUpdating = False
With Feuil1
  .[A3].CurrentRegion.Sort .[J3], xlAscending, Header:=xlYes 'tri sur les dates
  i = Application.Match(CLng(Date) - "1E-9", .[J:J])
  If IsError(i) Then i = 3
  Application.Goto .Cells(i + 1, 1), True 'cadrage
  .Cells(i + 1, 10).Select
End With
End Sub

Private Sub CommandButton1_Click()
Dim i As Variant
Application.ScreenUpdating = False
If CommandButton1.Caption = "Prochains RDV" Then
  [A3].CurrentRegion.Sort [J3], xlAscending, Header:=xlYes 'tri sur les dates
  i = Application.Match(CLng(Date) - "1E-9", [J:J])
  If IsError(i) Then i = 3
  Application.Goto Cells(i + 1, 1), True 'cadrage
  Cells(i + 1, 10).Select
  CommandButton1.Caption = "Ordre initial"
Else
  [A3].CurrentRegion.Sort [A3], xlAscending, Header:=xlYes 'tri sur les N°
  Application.Goto [A1], True
  CommandButton1.Caption = "Prochains RDV"
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim a As Range
With ListObjects(1).Range 'tableau Excel
  Application.EnableEvents = False 'désactive les évènements
  If Not Intersect(Target, .Columns(1)) Is Nothing Then
    For Each a In Target.Areas
      If a.Columns.Count < .Columns.Count Then Application.Undo: Exit For 'annule la modification
    Next
    ListObjects(1).Resize .Cells 'redimensionnement éventuel
    If Not Intersect(Target, .Cells(.Rows.Count, 1)) Is Nothing Then _
      .Cells(.Rows.Count, 1) = "" 'en cas d'entrée manuelle du N°
  End If
  If Application.CountBlank(.Columns(1)) Then 's'il manque des N°
    .Sort .Columns(1), xlAscending, Header:=xlYes 'tri sur les N°
    CommandButton1.Caption = "Prochains RDV"
    .Cells(2, 1) = 1
    .Cells(2, 1).Resize(.Rows.Count - 1).DataSeries 'nouvelle numérotation
  End If
  Application.EnableEvents = True 'réactive les évènements
End With
End Sub