Guten Tag zusammen,

ich bin auf der Suche nach einer passenden Lösung für mein Gruppierungs-Problem. Ich habe eine Excel Datei welche ca. so aufgebaut ist:

Headline
Subline
A
A
A
B
C
C
D
E
F
G
G
G
H
I

A, C, E und G sind hier quasi Zeilen mit gleichem Wert in Spalte A (gleiche Kategorie) und B, D, F und H sind das jeweilige Sub-Total (zu jeder Kategorie). I ist das gesamte Total. Nun möchte ich alle A Zeilen inkl. B gruppieren, alle C Zeilen inkl. D und so weiter. 

Bisher habe ich es geschafft alle Zeilen mit gleichem Wert in Spalte A plus die Subtotal Zeile drunter zu gruppieren (siehe Code unten). Allerdings bleiben Kategorien mit nur einer Datenzeile dann ungruppiert. Kann man da vielleicht noch was ergänzen?

Alternativ ginge ja eine Lösung die in meiner Daten-Range nach den Zeilen mit Format bold sucht und diese samt aller nicht bold Zeilen darüber gruppiert. Allerdings habe ich dazu noch keine passende Lösung gefunden und habe keinen Code entwickeln können, der das so macht. 

An der Stelle sei gesagt, dass ich absoluter Anfänger bin - demnach wäre ich wirklich über jede Hilfe & Unterstützung happy!

Vielen Dank im Voraus und beste Grüße,
Alex

    Dim r As Range
    Dim v As Variant
    Dim i As Long, j As Long

    With ActiveSheet
        On Error Resume Next
        ' expand all groups on sheet
        .Outline.ShowLevels RowLevels:=8
        ' remove any existing groups
        .Rows.Ungroup
        On Error GoTo 0
        Set r = .Range("A8", .Cells(.Rows.Count, 1).End(xlUp))
    End With

    With r
        'identify common groups in column B
        j = 1
        v = .Cells(j, 1).Value
        For i = 1 To .Rows.Count
            If v <> .Cells(i, 1) Then
                v = .Cells(i, 1)
                If i > j + 1 Then
                    .Cells(j, 1).Resize(i - j, 1).Rows.Group
                End If
                j = i
                v = .Cells(j, 1).Value
            End If
        Next
        ' create last group
             If i > j + 1 Then
                .Cells(j, 1).Resize(i - j, 1).Rows.Group
            End If
        ' collapse all groups
        .Parent.Outline.ShowLevels RowLevels:=1
    End With