Fusion de cellules

Version imprimable

1 pièce(s) jointe(s)

Fusion de cellules

Bonjour,

Bloqué je fais appel à vos compétences. J'avais trouvé un code sur le net que j'ai adapté à mes besoins, mais pour mon usage il est incomplet.

Voilà par macro, je récupère des données à partir d'une BD, sur 3 feuilles dont les nombres de colonne et de ligne sont variables.

Pour les éditer en pdf, je dois améliorer la présentation. Pour cela, je fusionne les cellules ayant la même valeur pour les colonnes A, B et C ainsi que les cellules de la ligne 7.

Je bloque pour fusionner les cellules suivantes:
1 - cells(7, dernièreColonne) et cells(8, dernièreColonne)
2 - cells(7, dernièreColonne - 1) et cells(8, dernièreColonne - 1).

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
Sub merging_Feuil_A_B_C()
 Dim i As Long, n As Long
 Dim Tp
 Application.ScreenUpdating = False
 Application.DisplayAlerts = False
 
 Tp = Array("A", "B", "C")
 For n = LBound(Tp) To UBound(Tp)
 
     With Sheets(Tp(n)) 'lenomdelafeuille
 
        For i = .Range("A" & .Rows.Count).End(xlUp).Row To 7 Step -1
            If UCase(.Cells(i, 1)) = UCase(.Cells(i - 1, 1)) Then
                .Cells(i - 1, 1) = ""
                .Range(.Cells(i, 1), .Cells(i - 1, 1)).merge
            End If
        Next i
 
        For i = .Range("B" & .Rows.Count).End(xlUp).Row To 7 Step -1
            If UCase(.Cells(i, 2)) = UCase(.Cells(i - 1, 2)) Then
                .Cells(i - 1, 2) = ""
                .Range(.Cells(i, 2), .Cells(i - 1, 2)).merge
            End If
        Next i
 
        For i = .Range("C" & .Rows.Count).End(xlUp).Row To 7 Step -1
            If UCase(.Cells(i, 3)) = UCase(.Cells(i - 1, 3)) Then
                .Cells(i - 1, 3) = ""
                .Range(.Cells(i, 3), .Cells(i - 1, 3)).merge
            End If
        Next i
 
        For i = .Cells(7, .Columns.Count).End(xlToLeft).Column To 2 Step -1
            If UCase(.Cells(7, i)) = UCase(.Cells(7, i - 1)) Then
                .Cells(7, i - 1) = ""
                .Range(.Cells(7, i), .Cells(7, i - 1)).merge
            End If
        Next i
    End With
     Next n
End Sub

Je vous remercie beaucoup.

Cordialement,

Tu n'as pas trouvé un code sur le net. Je te l'ai fait ;)

Mais comme je suis sympa, je te le fais à nouveau!

Code:

1
2
3
4
5
6
For i = .Cells(7, .Columns.Count).End(xlToLeft).Column +1 To 2 Step -1
            If UCase(.Cells(7, i)) = UCase(.Cells(7, i - 1)) Then
                .Cells(7, i - 1) = ""
                .Range(.Cells(7, i), .Cells(7, i - 1)).merge
            End If
        Next i

27/09/2013, 11h51
Invité

Bonjour EngueEngue,

Si c'est toi qui m'avais fait ce code, je t'en remercie doublement.

Je suis pas très versé en VBA. Bien souvent, quand je ne trouve pas sur le forum, je fais mes recherches sur google pour trouver des solutions.
Donc, je suis vraiment navré, si je n'ai pas eu souvenance que ce code était de toi. Encore, désolé.

Mais le résultat est le même qu'avec le précédent code. Je voudrais compléter le code pour fusionner les cellules suivantes:

1 - cells(cells(7,dernièreCol),cells(8, dernièreCol))
2 - cells(cells(7,dernièreCol - 1),cells(8, dernièreCol - 1))

Avec la configuration actuelle de mes feuilles les cellules concernées sont:
Feuille A: Range("L7:L8") et Range("M7:M8")
Feuille B: Range("L7:L8") et Range("M7:M8")
Feuille C: Range("J7:J8") et Range("K7:K8")

Merci beaucoup pour ton aide et ta sympathie.

Cordialement,

Je ne pense pas avoir très bien compris...

Si ma compréhension est bonne:

Rajoute tout à la fin:

Code:

1
2
3
4
5
6
7
On error resume next
Sheets("A").Range("L7:L8").merge 
Sheets("A").Range("M7:M8").merge 
Sheets("B").Range("L7:L8").merge 
Sheets("B").Range("M7:M8").merge 
Sheets("C").Range("J7:J8").merge 
Sheets("C").Range("K7:K8").merge

Ou alors avant de fermer ton with

Code:

1
2
 .range(cells(7,dernièreCol),cells(8, dernièreCol)).merge
 .range(cells(7,dernièreCol - 1),cells(8, dernièreCol - 1)).merge

Me doutant bien que tu ne vas pas être capable d'adapter...

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
Sub merging_Feuil_A_B_C()
 Dim i As Long, n As Long, derCol as long
 Dim Tp
 Application.ScreenUpdating = False
 Application.DisplayAlerts = False
 
 Tp = Array("A", "B", "C")
 For n = LBound(Tp) To UBound(Tp)
 
     With Sheets(Tp(n)) 'lenomdelafeuille
 derCol = .cells(7,.columns.count).end(xltoleft).column
        For i = .Range("A" & .Rows.Count).End(xlUp).Row To 7 Step -1
            If UCase(.Cells(i, 1)) = UCase(.Cells(i - 1, 1)) Then
                .Cells(i - 1, 1) = ""
                .Range(.Cells(i, 1), .Cells(i - 1, 1)).merge
            End If
        Next i
 
        For i = .Range("B" & .Rows.Count).End(xlUp).Row To 7 Step -1
            If UCase(.Cells(i, 2)) = UCase(.Cells(i - 1, 2)) Then
                .Cells(i - 1, 2) = ""
                .Range(.Cells(i, 2), .Cells(i - 1, 2)).merge
            End If
        Next i
 
        For i = .Range("C" & .Rows.Count).End(xlUp).Row To 7 Step -1
            If UCase(.Cells(i, 3)) = UCase(.Cells(i - 1, 3)) Then
                .Cells(i - 1, 3) = ""
                .Range(.Cells(i, 3), .Cells(i - 1, 3)).merge
            End If
        Next i
 
        For i = .Cells(7, .Columns.Count).End(xlToLeft).Column To 2 Step -1
            If UCase(.Cells(7, i)) = UCase(.Cells(7, i - 1)) Then
                .Cells(7, i - 1) = ""
                .Range(.Cells(7, i), .Cells(7, i - 1)).merge
            End If
        Next i
 .range(.cells(7,derCol),.cells(8, derCol)).merge
 .range(.cells(7,derCol - 1),.cells(8, derCol - 1)).merge
 
    End With
     Next n
 
 Application.ScreenUpdating = True
 Application.DisplayAlerts = True
End Sub

27/09/2013, 12h13
Invité
Re,

Comme les 3 feuilles sont obtenues par macro suivant certains critères que sélectionnent, le nombre de lignes et colonnes est variable.

Avec ton précédent code, la fusion s'effectue pour les colonnes A, B et C, ainsi que les cellules de la ligne 7.

Il manque avant de fermer le Next pour voir ci-dessous
Code:

1 2 .range(cells(7,dernièreCol),cells(8, dernièreCol)).merge .range(cells(7,dernièreCol - 1),cells(8, dernièreCol - 1)).merge
Je te remercie beaucoup.

Cordialement,
27/09/2013, 12h16
EngueEngue

Fait en #4
27/09/2013, 12h34
Invité

Re,

Désolé, je n'avais pas vu le post#5 et te remercie beaucoup.

Le dernier problème est en partie résolu, sauf pour les 2 premières cellules contigües ayant la même valeur, de la ligne 7 (ici B7:C7),
la fusion s'effectue pour 4 cellules, en l’occurrence B6,B7,C6 et C7 sont fusionnées. Mais pour les cellules suivantes les fusions s'effectuent juste sur la ligne 7.

Je n'ai pas compris pourquoi. Merci.

Cordialement,
27/09/2013, 12h39
EngueEngue

Comprends pas ta question

Remplace dans tes boucles

Code:

To 7 Step -1

par

Code:

To 8 Step -1
27/09/2013, 13h28
Invité

Re,

Je te remercie beaucoup. Tu m'as été d'un grand secours.

Merci pour ton aide, ta patience et ta sympathie.

ça fonctionne bien, maintenant je pourrais éditer mes feuilles en pdf.

Cordialement,