Adaptation code Fusion cellules pour 3 feuilles

[cathodique]

Bonjour,

Avec ce code, j'arrive à fusionner des cellules contigües ayant la même valeur pour la ligne 7 et la colonne A sur une seule feuille.

Sub merging_Feuil1()
 Dim i As Long
 
    With Sheets("A") 'Feuil1 'lenomdetafeuille
 
        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 = .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
 
End Sub

Mais en voulant l'adapter pour 3 feuilles nommées A, B et C, ça bug au niveau de la ligne signalée par des xxxx

Sub merging_Feuil_A_B_C()
 Dim i As Long, n As Long
 Dim Tp
 
 Application.ScreenUpdating = False
 
 Tp = Array("A", "B", "C")
 For n = LBound(Tp) To UBound(Tp)
 
     With Sheets(Tp(n)) ' Feuil1 'lenomdetafeuille
 
        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   'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxBUG
            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

Mon code n'est pas bon plus qu’il s'arrête sur une ligne. Merci de m'aider en corrigeant mon code ou me proposer un autre plus adapter.

Mes remerciements anticipés.

Cordialement,

 

[Caillou]

Re : Adaptation code Fusion cellules pour 3 feuilles

Bonjour,

Sans tester, juste comme ça, ne manque-t-il pas le point devant cells dans ta ligne
.Range(.Cells(i, 1), .Cells(i - 1, 1)).merge

Caillou

 

[pierrejean]

Re : Adaptation code Fusion cellules pour 3 feuilles

bonjour cathodique
A tester:

Sub merging_Feuil_A_B_C()
 Dim i As Long, n As Long
 Dim Tp
 
 Application.ScreenUpdating = False
 
 Tp = Array("A", "B", "C")
 For n = LBound(Tp) To UBound(Tp)
 
     With Sheets(Tp(n)) ' Feuil1 'lenomdetafeuille
 
        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   'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxBUG
            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

Edit: Salut Caillou (même avis !!!)

 

[cathodique]

[Résolu] : Adaptation code Fusion cellules pour 3 feuilles

Bonjour Caillou, Bonjour PierreJean,

Je vous remercie beaucoup. En effet, il manquait les points (.),je n'avais pas fait attention.
Mais ce que je ne comprends pas, c'est que le code ne planté pas alors que même dans celui-ci les points est manquant.

Bon, maintenant ça fonctionne bien grâce à vos corrections.

Je vous en remercie.

Cordialement,

 

[Caillou]

Re : [Résolu] : Adaptation code Fusion cellules pour 3 feuilles

Mais ce que je ne comprends pas, c'est que le code ne planté pas alors que même dans celui-ci les points est manquant.

ça ne plantait pas car il prenait la 'Cells' dans la feuille active au lieu de la prendre dans Sheets(Tp(n))

Bonjour Pierre Jean