Microsoft 365 Grouper ou regrouper en VBA

[malinsard]

Bonjour, je souhaite faire une macro pour grouper ou dégrouper des lignes.
En faite j('ai créer une feuille avec toutes les lettres de l'alphabet en groupant 20 lignes a chaque fois.
Je souhaiterai le faire via VBA.
Merci pour votre aide.

 

[Gégé-45550]

Bonjour, je souhaite faire une macro pour grouper ou dégrouper des lignes.
En faite j('ai créer une feuille avec toutes les lettres de l'alphabet en groupant 20 lignes a chaque fois.
Je souhaiterai le faire via VBA.
Merci pour votre aide.

Bonjour,
transformez votre tableau en tableau structuré et utilisez les filtres.
Sinon, joignez un fichier avec quelques données "exemples" et le résultat attendu.
Cordialement,

 

[sylvanu]

Bonjour Malinsard, Gégé,
En PJ un essai avec la macro :

Sub Construire()
Application.ScreenUpdating = False
Cells.EntireRow.Hidden = False
Cells.Clear
For L = 1 To 26
    Ligne = 21 * L - 20
    Lettre = Chr(64 + L)
    Rows(Ligne).Interior.Color = RGB(0, 0, 255)
    With Cells(Ligne, "A")
        .Font.Color = vbWhite
        .Font.Bold = True
        .Font.Size = 12
        .Value = Lettre
    End With
Next L
End Sub

Pour construire la feuille avec les 26 lettres et 20 lignes vides entre cahque.
La macro :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo Fin
Ligne = Target.Row
If Cells(Ligne, "A").Interior.Color <> vbBlue Then Exit Sub
Application.ScreenUpdating = False
For L = 1 To 27
    Ldeb = 21 * L - 20 + 1
    Lfin = 21 * L - 20 + 1 + 20 - 1
    Rows(Ldeb & ":" & Lfin).EntireRow.Hidden = True
Next L
Ldeb = Ligne + 1
Lfin = Ligne + 21
Rows(Ldeb & ":" & Lfin).EntireRow.Hidden = False
Fin:
End Sub

Quand on clique sur une "ligne entête", tout est masqué sauf l'espace de cette lettre.

 

[Staple1600]

Bonjour

Une autre façon de faire
En utilisant la fonctionnalité: Données/Plan/Grouper

NB: macro à exécuter une seule fois.

En uite cliquer sur le 1 ou le 2 en haut à gauche pour Grouper/Dégrouper

Sub Grouper()
j = 1
For i = 1 To 546 Step 21
Cells(i, 1) = Chr(64 + j)
Cells(i, 1).Offset(1).Resize(20).EntireRow.Group
j = j + 1
Next
End Sub

 

[malinsard]

Merci a tous pour votre aide.