Fusionner si bordure

Question

Bonjour,

Je cherche une Macro pouvant fusionner des cellules d’une colonne en fonction de leurs bordures.

Données de la colonne A fusionnées si bordures épaisses, Idem pour colonne B …

 

Je vous remercie

cs_Le Pivert · Answer

Bonjour, 

voici un exemple avec la colonne A fusionner vers le haut à adapter:

Sub For_X_to_Next_Ligne()
Dim FL1 As Worksheet, NoCol As Integer
Dim NoLig As Long
    Set FL1 = Worksheets("Feuil1")
    NoCol = 1 'lecture de la colonne 1
    For NoLig = 1 To Range("A" & Rows.Count).End(xlUp)
        FL1.Cells(NoLig, NoCol).Select
 If Selection.Borders(xlEdgeBottom).Weight = xlMedium Then 'bordure basse
     Range("A" & NoLig & ":A" & NoLig - 1).Select ' fusionner vers le haut
    Selection.Merge
        End If
        Next
    Set FL1 = Nothing
End Sub


Et si tu veux supprimer les alertes:

Sub For_X_to_Next_Ligne()
Dim FL1 As Worksheet, NoCol As Integer
Dim NoLig As Long
    Set FL1 = Worksheets("Feuil1")
    NoCol = 1 'lecture de la colonne 1
     Application.DisplayAlerts = False
    For NoLig = 1 To Range("A" & Rows.Count).End(xlUp)
        FL1.Cells(NoLig, NoCol).Select
 If Selection.Borders(xlEdgeBottom).Weight = xlMedium Then
     Range("A" & NoLig & ":A" & NoLig - 1).Select ' fusionner vers le haut
    Selection.Merge
        End If
        Next
    Set FL1 = Nothing
     Application.DisplayAlerts = True
End Sub

j'ai pris la bordure basse de la cellule. Si tu veux changer sers toi de l'enregistreur de macro pour avoir le code en mettant la bordure où tu veux
 
@+ Le Pivert

Carochris13010 · Answer

Merci beaucoup, je viens de tester cette Macro et celle ne fonctionne malheureusement pas sur mon tableau.
Cette dernière bloque à cette étape :   "For NoLig = 1 To Range("A" & Rows.Count).End(xlUp)"

Cordialement

cs_Le Pivert · Answer

Voilà

 http://www.cjoint.com/c/GJmghyVaaNQ

Fusionner si bordure

3 réponses

Discussions similaires

Newsletters