Mise en forme automatique de cellules identiques sur la même ligne

Bonjour,

Je suis assez novice en VBA et je bloque sur une macro que j'aimerai faire dans un classeur. Et j'aimerai un peu d'aide si possible

J'ai un classeur dans lequel en ligne 24 chaque colonne donne le numéro de la semaine en fonction de la date en ligne 23. Je me retrouve donc avec un tableau dans lequel à partir de la colonne G j'ai "Sem 1" puis en H "Sem 1 ainsi de suite en colonne K par exemple "Sem 2" etc. Cella change en fonction de l'année sélectionnée ailleurs. Tout ça fonctionne très bien mais j'aimerai faire une macro qui automatiquement Fusionne et met en forme les cellules de cette ligne 24 qui se suivent en étant identique. Par exemple si de G24 à J24 il est noté "Sem 1", puis de K24 à Q24 "Sem 2" etc j'aimerai que G24 à J24 soit fusionné, qu'il soit noté dans cette fusion "Sem 1" et mit en forme, puis idem avec k24 à Q24 etc pour toute la plage définie.

Avec mes quelques connaissance en VBA j'ai essayé de faire la macro ci-dessous. J'étais pourtant assez sure de moi mais malgré plusieurs essais impossible de comprendre pourquoi cela ne fonctionne pas... J('ai mis en commentaire volontairement la fusion des cellules et le style pour mes tests) avec le code ci-dessous. Le résultat de la macro est que je me retrouve avec les cellules BL47 à BN47 de sélectionnées impossible de comprendre comment ma macro atterrie si loin de mon but !

J'ai fais plusieurs test à savoir des MsgBox de mes variables dans mon For Each et je vois bien mes variables bougées comme elle le devrait. C'est à dire que DebutSemaine change bien à chaque Cellule qui n'a pas la même valeur que la précédente. FinSemaine elle commence de 7 à 40 il me semble en passant par chaque colonne de la plage. Et ma variable x elle aussi semble bonne. Donc comment en lançant ma macro ci-dessous je me retrouve en BL47?

A noter que si j'enlève les commentaire je me retrouver avec des fusions un peu étranges mais toujours en ligne 47... comment j'atterrie en 47?

Si je me suis mal fait comprendre je peux éventuellement vous envoyer le classeur pour mieux comprendre ce qu'il se passe.

Merci pour votre aide précieuse

Sub MEF_Semaines()

Dim Cells As Range
Set PLAGE = ActiveSheet.Range("H24:AM24")
x = ActiveSheet.Cells(24, 7).Value
DebutSemaine = 7
FinSemaine = 7

For Each Cells In PLAGE
If Cells.Value = x Then
    FinSemaine = FinSemaine + 1
Else
    ActiveSheet.Range(Cells(24, DebutSemaine), Cells(24, FinSemaine)).Select
'    Selection.MergeCells = True
'    Selection.Style = "Fusionner Vert"
    DebutSemaine = Cells.Column
    x = Cells.Value
End If
Next Cells

End Sub

Salut SliVeaX,

un début de solution...

Sub MEF_Semaines()
'
Dim rCel As Range, iCol%, iSem%
'
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'
With Worksheets("Planning")
    .Range("H23:AM23").MergeCells = False
    For Each rCel In .Range("H23:AM23")
        If DatePart("ww", CDate(rCel), 2, 2) <> iSem Then
            If iCol > 0 Then _
                .Range(fctCol(iCol) & 24).Value = "Sem " & iSem: _
                .Range(fctCol(iCol) & "24:" & fctCol(rCel.Column - 1) & 24).MergeCells = True: _
                .Range(fctCol(iCol) & "24:" & fctCol(rCel.Column - 1) & 24).HorizontalAlignment = xlHAlignCenter: _
                .Range(fctCol(iCol) & "24:" & fctCol(rCel.Column - 1) & 24).BorderAround LineStyle = xlContinuous: _
                .Range(fctCol(iCol) & "24:" & fctCol(rCel.Column - 1) & 24).Interior.Color = IIf(iSem Mod 2 = 0, RGB(195, 195, 195), RGB(255, 255, 255))
            iSem = DatePart("ww", CDate(rCel), 2, 2)
            iCol = rCel.Column
        End If
    Next
End With
'
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.EnableEvents = True
'
End Sub

Public Function fctCol(ByVal iCol%) As String
'
fctCol = Split(Columns(iCol).Address(ColumnAbsolute:=False), ":")(1)
'
End Function

J'ai testé sur mon agenda : parfait !

A+