Saisi date automatique si la cellule rempli et problèmr de 00/01/1900!

Option Explicit

Sub SupprimerDoub()
  Dim cel As Range, lig&: lig = 2: Application.ScreenUpdating = 0
  With Worksheets("Feuille2")
    With .ListObjects("Tableau505")
      With .Sort
        .SortFields.Clear
        .SortFields.Add Range("Tableau505[[Reste]]"): .Apply
      End With
      Do
        Set cel = .Parent.Cells(lig, 8): If cel = "" Then Exit Sub
        If cel = cel.Offset(-1) Then
          .ListRows(lig - 1).Delete: lig = lig - 1
        End If
        lig = lig + 1
      Loop
    End With
  End With
End Sub

Sub Saisie()
  If ActiveSheet.Name <> "Feuille1" Then Exit Sub
  Dim cel As Range: Set cel = [J18]: Application.ScreenUpdating = 0
  Worksheets("Feuille2").Select: Application.Calculation = -4105
  ActiveSheet.ListObjects("Tableau615").ListRows.Add 1
  ActiveSheet.ListObjects("Tableau504").ListRows.Add 2
  [K2] = cel: [F3] = cel: cel.ClearContents
  Worksheets("Feuille1").Select
End Sub

Sub Entrée()
  Application.Calculation = -4135
  With Worksheets("Data") '<<< A ADAPTER
    With .Range("F2:F40") 'la feuille 2 où l'action se passe
      t = .Value2
      For i = 1 To UBound(t)
        If Application.CountIf(.Cells, t(i, 1)) = 1 Then
          n = n + 1: t(n, 1) = t(i, 1)
        End If
      Next i
      .ClearContents
      If n > 0 Then .Resize(n).Value2 = t
    End With
    .Activate
  End With
  Application.Calculation = -4105
End Sub

Option Explicit

Private Sub Job()
  Application.Calculation = -4135: Application.ScreenUpdating = 0
  If [J18] <> "" Then Saisie: Exit Sub
  MsgBox "MERCI DE REMPLIR LE CHAMP VIDE SVP !", 48, "A VOTRE ATTENTION"
End Sub

Private Sub CommandButton2_Click()
  Call Job: Worksheets("Data").Activate: Application.Run "Entree"
  Worksheets("Tableau chauffeur").Activate
  Application.Calculation = -4105
End Sub

Private Sub CommandButton4_Click()
  Application.Calculation = -4135: Application.ScreenUpdating = 0
  'Call Annuler
  Application.Calculation = -4105
End Sub

Private Sub CommandButton5_Click()
  Application.Calculation = -4135: Application.ScreenUpdating = 0
  'Call Sortie
  Application.Calculation = -4105
End Sub

Private Sub CommandButton1_Click()
  Call Job: ActiveCell.Select
End Sub

Private Sub Job()
  Application.ScreenUpdating = 0
  If [J18] <> "" Then Saisie: Exit Sub
  MsgBox "MERCI DE REMPLIR LE CHAMP VIDE SVP !", 48, "A VOTRE ATTENTION"
End Sub

Private Sub CommandButton2_Click()
  Call Job: Worksheets("Data").Activate: Application.Run "Entree"
  Worksheets("Tableau chauffeur").Activate
End Sub

Private Sub Job()
  Application.ScreenUpdating = 0: Application.Calculation = -4105
  If [J18] <> "" Then Saisie: Exit Sub
  MsgBox "MERCI DE REMPLIR LE CHAMP VIDE SVP !", 48, "A VOTRE ATTENTION"
End Sub

Private Sub CommandButton2_Click()
  Call Job: Worksheets("Data").Activate: Application.Run "Entree"
  Worksheets("Tableau chauffeur").Activate
End Sub

Sub Essai()
  Application.ScreenUpdating = 0: Application.Calculation = -4135
  'ici, code de la sub qui s'exécute avec en mode de calcul manuel
  Application.Calculation = -4105
End Sub

Option Explicit

Sub D()
  'code de la sub D : exécuté en mode de calcul manuel
End Sub

Sub C()
  'code de la sub C : exécuté en mode de calcul manuel
  D 'appel de la sub D
End Sub

Sub B()
  'code de la sub B : exécuté en mode de calcul manuel
  C 'appel de la sub C
End Sub

Sub A()
  Application.ScreenUpdating = 0
  Application.Calculation = -4135 'calcul manuel
  B 'appel de la sub B
  Application.Calculation = -4105 'calcul auto.
End Sub

Private Sub AffMsg(chn$)
  MsgBox "MERCI DE REMPLIR " & chn & " SVP !", 48, "À VOTRE ATTENTION"
End Sub

Private Sub CommandButton1_Click()
  If [J7] = "" Or [J10] = "" Then AffMsg "TOUS LES CHAMPS": Exit Sub
  Application.ScreenUpdating = 0: Application.Calculation = -4135
  Call Nouveauchauffeur: Application.Calculation = -4105
End Sub

Private Sub CommandButton2_Click()
  If [J18] = "" Then AffMsg "LE CHAMP VIDE": Exit Sub
  Application.ScreenUpdating = 0: Application.Calculation = -4135
  Call Saisie: Worksheets("Data").Select: Entrée
  Worksheets("Tableau chauffeur").Select
  Application.Calculation = -4105
End Sub

Private Sub CommandButton3_Click()
  If [L7] = "" And [L10] <> "" Then AffMsg "LE CHAMP VIDE": Exit Sub
  Application.ScreenUpdating = 0: Application.Calculation = -4135
  Call Ntrailer: Application.Calculation = -4105
End Sub

Private Sub CommandButton4_Click()
  Application.ScreenUpdating = 0: Application.Calculation = -4135
  Call Annuler: Application.Calculation = -4105
End Sub

Private Sub CommandButton5_Click()
  Application.ScreenUpdating = 0: Application.Calculation = -4105
  Call Sortie: Application.Calculation = -4105
End Sub

Private Sub CommandButton3_Click()
  If [L7] = "" And [L10] <> "" Then AffMsg "LES CHAMPS": Exit Sub
  Application.ScreenUpdating = 0: Application.Calculation = -4135
  If [L7] <> "" Then Ntrailer1
  If [L10] <> "" Then Ntrailer2
  Application.Calculation = -4105
End Sub