Optimisation de calendrier

Bonjour,

Je veux faire un calendrier dans Excel: dans chaque cellule de la ligne 5 j'ai le numéro du jour, en ligne 4 j'ai le "nom" du jour, en ligne 3 j'ai une fusion de 7 cellules par semaine avec le numéro de semaine,
en ligne 2 j'ai une fusion de x cellules par mois avec le "nom" du mois.
Je remplis tout ça d'après une variable "annee" de la manière suivante:

annee = 2022
StartDate = DateSerial(annee, 1, 1)
EndDate = DateSerial(annee, 12, 31)
Jours = DateDiff("d", StartDate, EndDate) + 1

***blabla clearcontents et unmerge pour débuter sur une base saine...je passe***
For j = 1 to Jours
 cells(5,j).value = StartDate + j -1
 cells(4,j).value = Format(StartDate + j - 1, "ddd", vbMonday, vbFirstFourDays)

'Si le jour est un dimanche: je fusionne les 7 cellules en ligne 3
If Weekday(StartDate + j - 1) = vbSunday Then
  Select Case j
    Case 1 :'rien, pas de mise en forme particulière   
    Case Is <= 7
      Range(Cells(3, 1), Cells(3, 6 + j)).Merge
      Range(Cells(3, 1), Cells(3, 6 + j)).Borders(xlEdgeLeft).LineStyle = xlContinuous
      Range(Cells(3, 1), Cells(3, 6 + j)).Borders(xlEdgeRight).LineStyle = xlContinuous
      Cells(3, 1).Value = "S" & DatePart("ww", Cells(5, 4).Value, vbMonday, vbFirstFourDays)
    Case Is > Jours - 7
      Range(Cells(3, j-6 ), Cells(3, j)).Merge
      Range(Cells(3, j -6), Cells(3, j)).Borders(xlEdgeLeft).LineStyle = xlContinuous
      Range(Cells(3, j -6), Cells(3, j)).Borders(xlEdgeRight).LineStyle = xlContinuous
      Cells(3, j - 6).Value = "S" & DatePart("ww", Cells(5, j - 6).Value, vbMonday, vbFirstFourDays)
      Range(Cells(3,  j+1), Cells(3, Jours)).Merge
      Range(Cells(3, j+1), Cells(3, Jours)).Borders(xlEdgeRight).LineStyle = xlContinuous
      Cells(3,  j+1).Value = "S" & CInt(DatePart("ww", Cells(5, j - 6).Value, vbMonday, vbFirstFourDays)) + 1
    Case Else
      Range(Cells(3, j - 6), Cells(3, j)).Merge
      Range(Cells(3, j - 6), Cells(3, j)).Borders(xlEdgeRight).LineStyle = xlContinuous
      Cells(3, j - 6).Value = "S" & DatePart("ww", Cells(5, j - 6).Value, vbMonday, vbFirstFourDays)
    End Select

  End If

'si le jour est un premier, je fusionne les x jours du mois en ligne 2
  If Day(StartDate + j - 1) = 1 Then
            nb_jours = Day(DateSerial(annee, Month(StartDate + j - 1) + 1, 1) - 1)
            Range(Cells(2, j), Cells(2, j + nb_jours - 1)).Merge
            Range(Cells(2, j), Cells(2, j + nb_jours - 1)).Borders(xlEdgeRight).LineStyle = xlContinuous
            mois = Format(StartDate + j - 1, "MMMM")
            Cells(2, j).Value = UCase(Left(mois, 1)) & Right(mois, Len(mois) - 1)
  End If

Next j

Mais que c'est long!!! J'ai bien sur fait

application.screenupdating = false 
application.calculation = xlmanual

Quelqu'un a des idées pour accélerer tout ça?
PS: La mise en forme est imposée...sinon je me passerai bien des merge.