Mise en forme des lignes visibles

Bonjour à tous,

J'essaie, sans succès, de mettre en forme mes lignes visibles.

Voici mon essai :

Sub test()

Application.ScreenUpdating = False
Application.CutCopyMode = False
Application.Calculation = xlManual
Application.DisplayStatusBar = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False

Dim Cel As Range

Sheets("TM").Range("A4:BE1300").Borders.LineStyle = xlContinuous

    With Worksheets("TM")
        DerLig = .Range("B" & .Rows.Count).End(xlUp).Row
        For i = DerLig To 4 Step -1
        For Each Cel In Range("B4:B" & DerLig).SpecialCells(xlCellTypeVisible)
            If Cel(i, 1) <> Cel(i - 1, 1) Then Range("B" & i & ":" & "BE" & i).Borders(xlEdgeTop).Weight = 4
        Next
        Next
    End With

End Sub

Infructueux : toutes mes lignes se retrouvent en borders 4....

Je tente de divers manières mais sans parvenir à ce que je cherche :

si le contenu de ma ligne suivante en colonne B, uniquement les lignes visibles, est différente : une séparation se fait en grossissant ma bordure

Ca fonctionne nickel quand je ne suis pas en filtre, mais je voudrais également faire cette manipulation quand mes données sont filtrées.

Merci à tous,

Lorence

Bonjour,

à tester car sans fichier je ne peux pas tester moi même:

Sub test()

Application.ScreenUpdating = False
Application.CutCopyMode = False
Application.Calculation = xlManual
Application.DisplayStatusBar = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False

Dim Cel As Range, Visibles As Range
Dim lignes As Variant
Dim indexLignes As Integer

indexLignes = 0

Sheets("TM").Range("A4:BE1300").Borders.LineStyle = xlContinuous

    With Worksheets("TM")
        derlig = .Range("B" & .Rows.Count).End(xlUp).Row
        Set Visibles = .Range("B4", "B" & derlig).SpecialCells(xlCellTypeVisible)

        ReDim lignes(1 To Visibles.Count)

        For Each Cel In Visibles
            indexLignes = indexLignes + 1

            lignes(indexLignes) = Cel.Row
        Next Cel

        For i = 2 To UBound(lignes, 1)
            If Range("B" & lignes(i)) <> Range("B" & lignes(i - 1)) Then
                Range("B" & lignes(i) & ":" & "BE" & lignes(i)).Borders(xlEdgeTop).Weight = 4
            Next
        Next
    End With
End Sub

Je n'aurais jamais trouvé par moi même.

Merci beaucoup Ausecour

Je pense que ce post aidera d'autres personnes car malgré mes recherches je n'avais pas trouvé.

PS : Il y a juste le dernier "next" en trop si quelqu'un en a besoin

Bonjour,

Super!

Oui petit correctif sur le code du coup:

Sub test()

Application.ScreenUpdating = False
Application.CutCopyMode = False
Application.Calculation = xlManual
Application.DisplayStatusBar = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False

Dim Cel As Range, Visibles As Range
Dim lignes As Variant
Dim indexLignes As Integer

indexLignes = 0

Sheets("TM").Range("A4:BE1300").Borders.LineStyle = xlContinuous

    With Worksheets("TM")
        derlig = .Range("B" & .Rows.Count).End(xlUp).Row
        Set Visibles = .Range("B4", "B" & derlig).SpecialCells(xlCellTypeVisible)

        ReDim lignes(1 To Visibles.Count)

        For Each Cel In Visibles
            indexLignes = indexLignes + 1

            lignes(indexLignes) = Cel.Row
        Next Cel

        For i = 2 To UBound(lignes, 1)
            If Range("B" & lignes(i)) <> Range("B" & lignes(i - 1)) Then
                Range("B" & lignes(i) & ":" & "BE" & lignes(i)).Borders(xlEdgeTop).Weight = 4
            End If
        Next i
    End With
End Sub