Planning de Gantt - Problème pour fusionner des cellules

Bonjour,

je veux me créer un planning de Gantt où il est possible de changer la date de début et la date de fin.

Dans ce planning, j'aimerai que Excel me fusionne les cellules pour indiquer le mois (lignes 5 et 6 dans mon fichier).

J'ai tapé ce code :

Dim Col As Integer, Colon As Integer, DerCol As Integer, Dcol As Integer, Mois As Variant, FinMois As Variant
Dim Date_Test As Date, Date_Mois_Suivant As Date, Dernier_Jour_Mois As Date, Nbre_Jour As Integer
Dim CA As Range, Nb As Integer, Target As Range

    With Range("F5:ZZ6")
        .Value = ""
        .MergeCells = False
        .Interior.ThemeColor = xlNone
        .Borders(xlEdgeLeft).LineStyle = xlNone
        .Borders(xlEdgeRight).LineStyle = xlNone
        .Borders(xlEdgeTop).LineStyle = xlNone
        .Borders(xlEdgeBottom).LineStyle = xlNone
    End With
    Dcol = Cells(10, Cells.Columns.Count).End(xlToLeft).Column

    Col = 6

    While Col <= Dcol

            If Cells(11, Col) <> "" Then

            'Une date de la cellule
            Date_Test = CDate(Cells(11, Col))

            'Mois / année de la date
            Mois = Month(Date_Test)
            Annee = Year(Date_Test)

            'Calcul du premier jour du mois suivant
            Date_Mois_Suivant = DateSerial(Annee, Mois + 1, 1)

            'Date du dernier jour
            Dernier_Jour_Mois = Date_Mois_Suivant - 1

            'Nombre de jour dans le mois (= dernier jour)
            Nbre_Jour = Day(Dernier_Jour_Mois) - Day(Cells(11, Col))

            MsgBox Dernier_Jour_Mois & Chr(10) & Cells(10, Col + Nbre_Jour)

            Colon = Col + Nbre_Jour
            MsgBox Colon

            End If

           MsgBox Mois
           MsgBox Col

            Range(Cells(5, Col), Cells(6, Colon)).Select
                With Selection

                    .MergeCells = True
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlCenter
                    .FormulaR1C1 = "=EDATE(R[6]C,0)"
                    .NumberFormat = "mmmm"
                    .Font.Size = 14
                    .Font.Bold = True
                    With Selection.Interior
                        .Pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                        .ThemeColor = xlThemeColorAccent5
                        .TintAndShade = 0.599993896298105
                        .PatternTintAndShade = 0
                    End With
                    .Borders(xlDiagonalDown).LineStyle = xlNone
                    .Borders(xlDiagonalUp).LineStyle = xlNone
                    With Selection.Borders(xlEdgeLeft)
                        .LineStyle = xlContinuous
                        .ColorIndex = xlAutomatic
                        .TintAndShade = 0
                        .Weight = xlMedium
                    End With
                    With Selection.Borders(xlEdgeTop)
                        .LineStyle = xlContinuous
                        .ColorIndex = xlAutomatic
                        .TintAndShade = 0
                        .Weight = xlMedium
                    End With
                    With Selection.Borders(xlEdgeBottom)
                        .LineStyle = xlContinuous
                        .ColorIndex = xlAutomatic
                        .TintAndShade = 0
                        .Weight = xlMedium
                    End With
                    With Selection.Borders(xlEdgeRight)
                        .LineStyle = xlContinuous
                        .ColorIndex = xlAutomatic
                        .TintAndShade = 0
                        .Weight = xlMedium
                    End With
                    Selection.Borders(xlInsideVertical).LineStyle = xlNone
                    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

                End With

           Col = Col + Colon - 5

    Wend

    Range("C3:E7").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With

Application.ScreenUpdating = True

Or, quand je lance ma macro, il fait bien Janvier, Février puis va directement à Avril et enfin fusionne les cellules HJ5 et HJ6 qui correspondent au 31 juillet.

Je ne comprends pas pourquoi il ne me fait pas tous les mois

Si quelqu'un peut me renseigner sur ce problème, merci par avance

Ci joint mon fichier, le code est sur la feuille 1 en Private Sub Worksheet_Activate(). Vous verrez de temps à autre des MsgBox, je les mets lors de ma programmation pour contrôle.

Une petite erreur dans le code :

Dcol = Cells(11, Cells.Columns.Count).End(xlToLeft).Column

et non pas Dcol = Cells(10, Cells.Columns.Count).End(xlToLeft).Column

Cependant, ceci ne change rien à mon problème, je n'ai toujours pas les cellules fusionnées comme je le voudrai