Appliquer macro sous condition

Bonjour,

J'ai trouver cette Macro sur le net qui permet de fusionner automatiquement des cellules lorsqu'on les sélectionnes.

Ci-joint un exemple de ce que je souhaite

La macro qui me permet de fusionner :

Sub FUSIONNER()
'
' FUSIONNER Macro
'
' Touche de raccourci du clavier: Ctrl+q

Dim Colonne As Long
Dim Ligne As Long
Dim ColonneFin As Long
Dim LigneFin As Long
Dim ResultCell As Variant

With Selection
    Ligne = .Cells(1).Row
    LigneFin = .Cells(.Cells.Count).Row
    Colonne = .Cells(1).Column
    ColonneFin = 12
End With

For i = Colonne To ColonneFin
    ResultCell = ""
    For j = Ligne To LigneFin
        Range(Chr(64 + i) & CStr(j)).Select
        ch = Chr(10)
        If j = LigneFin Then ch = ""
        ResultCell = ResultCell & ActiveCell.FormulaR1C1 & ch
        ActiveCell.FormulaR1C1 = ""
    Next j
   Range(Chr(64 + i) & CStr(Ligne), Chr(64 + i) & CStr(j - 1)).Merge
   Range(Chr(64 + i) & CStr(Ligne), Chr(64 + i) & CStr(j - 1)).WrapText = True
    Range(Chr(64 + i) & CStr(Ligne)).FormulaR1C1 = ResultCell
    Next i
Range(Chr(64 + Colonne + 1) & CStr(Ligne), Chr(64 + ColonneFin) & CStr(LigneFin)).Select
'Selection.Delete Shift:=xlToLeft
End Sub

J'aimerais automatiser l'utilisation de cette macro (car mon tableau complet fait 20 000 lignes et 12 colonnes) , c'est à dire :

Lorsque les cellules de la colonne B sont vides, on les fusionnes avec la valeur du dessus (avec l'exemple ci-joint ce sera plus clair )

En vous remerciant par avance !

Bonjour,

oh là là quelle horreur ! des cellules fusionnées ...

tu peux avoir la même présentation avec une MFC

Bonjour le fil, bonjour le forum,

D'accord avec Steelson. VBA et cellules fusionnées ne font pas bon ménage...

Malgré cela tu peux essayer le code ci-dessous :

Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim DL As Long 'déclare la variable DL (Onglet)
Dim PL As Range 'déclare la variable PL (PLage)
Dim CEL As Range 'déclare la variable CEL (CELlulle)
Dim CF As Range 'déclare la variable CF (Cellules Fusionnées)

Set O = Worksheets("Feuil1") 'définit l'onglet O
DL = O.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée Dl de la colonne A de l'onglet O
Set PL = O.Range("B1:B" & DL) 'définit la plage PL
Set CF = O.Range("B1") 'Initialise la plage CF
For Each CEL In PL 'boucle sur toutes les cellule CEL de la plage PL
    If CEL.Offset(1, 0).Value = "" Then 'condition : si la le cellule en-dessous est vide
        Set CF = Application.Union(CF, CEL.Offset(1, 0)) 'définit la plage CF
    Else 'sinon
        CF.Merge 'fusionne la plage CF
        Set CF = CEL.Offset(1, 0) 'redéfinit la plage CF
    End If 'fin de la condition
Next CEL 'prochaine cellule de la boucle
End Sub

Merci beaucoup pour vos réponses je test ça demain matin !!

Et bah merci beaucoup ça fonctionne parfaitement c'est encore mieux que ce que je souhaitait, j'ai très légèrement modifié la macro mais c'est top ! (rajout d'un Application.DisplayAlerts = False au tout début pour éviter de taper sur entrée pour retirer le message de fusion à chaque fois et j'ai limité la plage sinon la macro plante sur mon PC).

J'ai perso une préférence pour le VBA car je ne maîtrise pas MFC mais j'imagine que la solution MFC fonctionne aussi.

La macro dès fois que ça puisse servir à quelqu'un (j'ai retiré la limite de plage) (pensez à ajouter un Application.DisplayAlerts = True à la fin de la macro si besoin) :

Sub Macro1()
Application.DisplayAlerts = False
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim DL As Long 'déclare la variable DL (Onglet)
Dim PL As Range 'déclare la variable PL (PLage)
Dim CEL As Range 'déclare la variable CEL (CELlulle)
Dim CF As Range 'déclare la variable CF (Cellules Fusionnées)

Set O = Worksheets("Global") 'définit l'onglet O
DL = O.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée Dl de la colonne A de l'onglet O
Set PL = O.Range("C2:C" & DL) 'définit la plage PL
Set CF = O.Range("C1") 'Initialise la plage CF
For Each CEL In PL 'boucle sur toutes les cellule CEL de la plage PL
    If CEL.Offset(1, 0).Value = "" Then 'condition : si la le cellule en-dessous est vide
        Set CF = Application.Union(CF, CEL.Offset(1, 0)) 'définit la plage CF
    Else 'sinon
        CF.Merge 'fusionne la plage CF
        Set CF = CEL.Offset(1, 0) 'redéfinit la plage CF
    End If 'fin de la condition
Next CEL 'prochaine cellule de la boucle
End Sub

En vous remerciant encore, bonne journée