Fusionner des cellules avec plage et valeurs variables

Bonjour à tous,

je n'arrive pas à créer une macro qui fusionne des plages de cellules lorsuq'elles sont identiques.

Je m'explique, je réalise un planning de cours hebdomadaire, ces cours sont destinés soit à un groupe d'élèves soit à la promo tout entière. je voudrais que les cellules contenant les cours pour la promo soient fusionnés automatiquement.

sur la capture d'écran vous pouvez voir que les G1,2,3 et 4 ont le meme cours de 9h à 10h30 et ainsi de suite.

je voudrais que les cellules ainsi définiés soient fusionnées.

chaque semaines les cours en c=promo changent de date, d'heure etc...

comment définir cette plage de taille variable? ce qu'on sait c'est qu'elle occupe 8 lignes et que le contenu est le meme.

je vous joins le fichier

merci d'avance

j'ai essayé de faire une macro pour la zone D5:CE12 mais elle ne fonctionne pas j'ai un problème pour réaliser la synthaxe de mon code.

Sub fusion_promo2()
Dim i As Integer, lg As Integer, c As Object, c2 As Object, c3 As Object, c4 As Object

    Range("D5:CE12").Activate
    lg = 5

        For i = 4 To 84

         c = Cells(lg, i)
        c2 = Cells(lg + 2, i)
        c3 = Cells(lg + 4, i)
        c4 = Cells(lg + 6, i)

        On Error Resume Next

    If c.Value = c2.Value And c.Value = c3.Value And c.Value = c4.Value Then Range("c;c4").Select

            With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = True

            End With
            i = i + 1

        End If

End Sub

l'idée c'est de parcourir chaque bloc de 8 cellules par colonne de la colonne D à CE soit de 4 à 84

de tester si les cellules ont la meme valeur si oui on les fusionne sinon on passe à la colonne suivante.

quelqu'un pourrait il m'aider à corriger ce code?

il s'applique sur le fichier joint hier.

merci d'avance

bonjour à tous

j'ai considérablement simplifié le code mais il ne fonctionne que sur la première colonne quelqu'un saurait il me dire pourquoi?

Sub fusion_promo2()

Dim i As Integer

   Cells(5, 4).Select

 For i = 4 To 84

    If Cells(5, i).Value = Cells(7, i).Value And Cells(5, i).Value = Cells(9, i).Value And Cells(5, i).Value = Cells(11, i).Value Then ActiveCell.Resize(8, 1).merge

 Next

End Sub

merci pour votre aide

Bonjour,

Avec l’instruction ActiveCell.Resize(8, 1).Merge, tu fusionnes une plage définie à partir de la cellule active. Or, avec ton code, la cellule active est toujours la même (D5).

Fais ce test

Sub fusion_promo2()
Dim i As Integer
    For i = 4 To 84
        Cells(5, i).Select
        If _
        Cells(5, i).Value = Cells(7, i).Value And _
        Cells(5, i).Value = Cells(9, i).Value And _
        Cells(5, i).Value = Cells(11, i).Value Then
            ActiveCell.Resize(8, 1).Merge
        End If
    Next
End Sub

A+

merci en effet je n'avais plus pensé à ça.

merci à toi

Un début de solution

(clic sur le bouton "Fusion" en haut à droite de la feuille)

Remarque : à utiliser les plages fusionnées, tu n'as pas fini de t'em......

A+

merci pour ta proposition, je mets en dessous le code que j'ai finalement utilisé:

Sub fusion_promo2()
Application.DisplayAlerts = False
Application.ScreenUpdating = False

Dim i As Integer
Dim j As Integer

j = 5
While j < 54

    For i = 4 To 84

    Cells(j, i).Select

    If Cells(j, i).Value = Cells(j + 2, i).Value And Cells(j, i).Value = Cells(j + 4, i).Value And Cells(j, i).Value = Cells(j + 6, i).Value Then ActiveCell.Resize(8, 1).merge

    Next
j = j + 12
Wend

Application.ScreenUpdating = True

End Sub

je sais que la fusion n'est pas forcément la solution la plus pertinente mais comme c'est dans un soucis de lisibilité du planning par la suite j'ai fait le choix d'utiliser cette méthode.

je ne sais pas comment j'aurais pu faire autrement.

merci

Bonjour,

Attention, avec ton code je n'obtiens pas un résultat correct.

Certaines zones sont fusionnées à tort.

A+

Merci pôur ton avertissement je m'en suis rendu compte après avoir testé sur plusieurs feuilles différentes.

je vais remplacer mon code par le tien

bonjour

j'ai fait le remplacement, j'ai cependant un problème si sur deux lignes consécutives j'ai seulement deux cellules qui correspondent à la condition alors elles fusionnent.

je voudrais que cela n'arrive que si c'est les cellules sur 4 lignes, c'est pour cela que j'avais la condition Val1=val2=val3=val4.

comment pourrais modifier les code pour cela soit vrai.

dois-je rajouter quatre variables? ou utiliser une méthode autre que offset dans le code?

merci pour ton aide

Bonjour,

A tester

A+