XL 2021 création planning avec nouveau calendrier

Private Sub CommandButton1_Click()
Dim pos As Long, NewHorr As Long
Dim Heur As Long
Dim j As Long

If rdv = "" Then
   MsgBox "vous n'avez pas Renseigné le Motif du R.d.V."
   rdv.SetFocus
   Exit Sub
ElseIf Not IsNumeric(horaire) Then
   MsgBox "vous n'avez pas Renseigné l'horaire."
   horaire.SetFocus
   Exit Sub
End If
 
Heur = CLng(horaire)
j = IIf(Heur < 12, 1, 8)
'x = IIf(j = 1, "Le Matin", "L'Apres-Midi")
On Error Resume Next
 pos = Application.Match(CLng(CDate(JourJ)), Sheets("Calendrier").Range("A4:A369"), 0)
On Error GoTo 0
If pos = 0 Then
   MsgBox "Date invalide " & JourJ
   Exit Sub
End If
 
  With Sheets("Calendrier").Range("A4:A369").Cells(pos, 1)
    If .Offset(0, j) = "" Then
        NewHorr = j
    ElseIf .Offset(0, j + 2) = "" Then
        NewHorr = j + 2
    ElseIf .Offset(0, j + 4) = "" Then
        NewHorr = j + 4
    Else
       MsgBox " Les  3  Rendez-Vous pour: " & "     " & "sont pris pour la journéé du : " & ""
       Exit Sub
    End If
    .Offset(0, NewHorr) = horaire        ' utilisation de la variable dep
    .Offset(0, NewHorr + 1) = rdv
    .Select
  End With
End Sub