Sub Grouper()
Dim deb As Range, i&
Application.ScreenUpdating = False
Cells.ClearOutline 'RAZ
With [A1].CurrentRegion
Set deb = .Cells(3, 1)
For i = 4 To .Rows.Count + 1
If .Cells(i, 1) <> .Cells(i - 1, 1) Then
Range(deb, .Cells(i - 1, 1)).EntireRow.Group
i = i + 1
Set deb = .Cells(i, 1)
End If
Next
End With
ActiveSheet.Outline.ShowLevels RowLevels:=1
End Sub
Sub Grouper()
If IsError(Application.Caller) Then Exit Sub 'sécurité
Dim a As Range, groupe As Boolean
Application.ScreenUpdating = False
Cells.ClearOutline 'RAZ
If ActiveSheet.DrawingObjects(Application.Caller).Text = "Grouper" Then
With [A1].CurrentRegion.Columns(3) 'colonne auxiliaire
.Formula = "=1/Couleur(A1,A$2)"
On Error Resume Next 'si aucune SpecialCell
For Each a In .SpecialCells(xlCellTypeFormulas, 16).Areas
a.EntireRow.Group
Next
.Clear
End With
ActiveSheet.Outline.ShowLevels RowLevels:=1
groupe = True
End If
ActiveSheet.DrawingObjects(Application.Caller).Text = IIf(groupe, "Dégrouper", "Grouper")
End Sub
Function Couleur(c As Range, ref As Range)
Couleur = c.Interior.Color = ref.Interior.Color
End Function