Décaler une sélection pour fusionner les cellules à droite

Bonjour,

J'aimerais savoir comment faire

A partir d'une cellule déjà fusionnée et sélectionnée, se déplacer sur la cellule juste à droite et fusionner le même nombre de lignes que la première cellule, le tout sur plusieurs colonnes. Sachant que le nombre de ligne est déterminé par la sélection de la première cellule.

Merci pour votre aide.

Bonjour

Un essai à tester. Te convient-il ?

Bye !

Bonjour gmb,

Lorsque je fais l'essai, la sélection passe à la cellule juste en dessous et c'est tout.

En essayant d'être plus précis :

Donc en sélectionnant A2:G6, qui est déjà fusionnée et sélectionnée, je souhaiterai fusionner H2:I6, puis J2:J6.

En tout cas merci pour cette réponse gmb.

Je n’arrive pas à trouver ce qui coince dans ton code...

Option Explicit

Dim lnD&, colD, nbL&, nbC&, nbColF&, col&, derCol&, rep

Sub Fusionner()

lnD = ActiveCell.Row

colD = ActiveCell.Column

rep = MsgBox("La plage de départ est-elle bien :" & _

Chr(13) & Chr(13) & Selection.Address & " ?", 20)

If rep = 7 Then Exit Sub

Application.ScreenUpdating = False

nbC = Selection.Columns.Count

ActiveCell.Offset(1, 0).Select

nbL = Selection.Rows.Count

derCol = Cells(lnD, Columns.Count).End(xlToLeft).Column

For col = colD + nbC To derCol

Cells(lnD, col).Select

nbColF = Selection.Columns.Count

Selection.Offset(1, 0).Resize(nbL, nbColF).Select

Selection.Merge

col = col + nbColF - 1

Next col

End Sub

Bonjour à tous,

Je préfère le double-clic comme événement déclencheur.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim ligs As Range, pl As Range, pl2 As Range, dercol As Long, col As Long
    If Target(1).Column = 1 And Target.Row > 1 Then
        Cancel = True
        Set ligs = Target.Columns(1).EntireRow
        Set pl = Target(Target.Columns.Count).Offset(-1, 1) 'cell au-dessus à droite fusion cliquée
        dercol = Cells(pl.Row, Columns.Count).End(xlToLeft).Column
        dercol = dercol + Cells(pl.Row, dercol).MergeArea.Columns.Count - 1
        For col = pl.Column To dercol
            Set pl2 = Intersect(ligs, Cells(pl.Row, col).MergeArea.EntireColumn)
            If pl2.MergeCells Then pl2.UnMerge
            pl2.Merge
            col = col + pl2.Columns.Count - 1
        Next col
    End If
End Sub

en théorie la cellule double-cliquée peut se trouver n'importe où (sauf ligne 1). Ici limitée colonne B.

eric

Bonjour Eric

Le code que tu proposes est à placer dans une feuille, pas dans un module ?

Quand je test le double clique ne lance rien...

Je désespère

Moi qui pensait que ce ne serait pas trop compliqué, il me reste juste ce problème pour finaliser un projet...

Bobleponge a écrit :

Donc en sélectionnant A2:G6, qui est déjà fusionnée et sélectionnée,

Je suis parti de la plage A1:G1 et j'obtiens :

Bye !

Merci gmb pour cette réponse

Ça parait simple mais, je n'arrive pas adapter ce code pour mon problème.

Ici avec ce code ça ne marche que si je suis en A1:G1.

Or il se trouve que j'ai plusieurs cellules fusionnées de Ax:Gx, mais de taille variable (en nombre de ligne).

Je souhaiterai donc en me plaçant sur une de ces lignes, fusionner la cellule à sa droite du même nombre de ligne.

Code à mettre dans le module de la feuille bien entendu

Double-clic sur Avant dans le fichier joint

eric

Bon en décortiquant vos codes j'ai réussi à faire une macro qui correspond à mes attentes.

Elle peut surement être optimisée mais elle fonctionne.

Merci à bmg et Eriic.

Pour l'optimisation s'il y a moyen, je suis preneur.

Sub FusionnerCell2()

lnD = ActiveCell.Row

colD = ActiveCell.Column

Application.ScreenUpdating = False

Cells(lnD, colD).Select

nbL = Selection.Rows.Count

nbColF = Selection.Columns.Count

Selection.Offset(0, 1).Resize(nbL, 2).Select

Selection.Merge

lnD = ActiveCell.Row

colD = ActiveCell.Column

Application.ScreenUpdating = False

Cells(lnD, colD).Select

nbL = Selection.Rows.Count

nbColF = Selection.Columns.Count

Selection.Offset(0, 1).Resize(nbL, 1).Select

Selection.Merge

lnD = ActiveCell.Row

colD = ActiveCell.Column

Application.ScreenUpdating = False

Cells(lnD, colD).Select

nbL = Selection.Rows.Count

nbColF = Selection.Columns.Count

Selection.Offset(0, 1).Resize(nbL, 1).Select

Selection.Merge

lnD = ActiveCell.Row

colD = ActiveCell.Column

Application.ScreenUpdating = False

Cells(lnD, colD).Select

nbL = Selection.Rows.Count

nbColF = Selection.Columns.Count

Selection.Offset(0, 1).Resize(nbL, 1).Select

Selection.Merge

End Sub

Pour moi ma macro fonctionne sur ton fichier de test et est optimisée.

As-tu seulement testé le fichier mis ensuite pour te le montrer ?

PS : on ne devrait faire .Select que lorsqu'on n'a pas le choix.

lnD = ActiveCell.Row
colD = ActiveCell.Column
Application.ScreenUpdating = False
Cells(lnD, colD).Select

Non seulement tu peux te passer des .Select, mais toi tu resélectionnes une cellule déjà sélectionnée avec ça ?!?

Merci à tous pour votre participation !