Excel Zeilen automatisch gruppieren (Makro)

Sub GroupRows()
    On Error Resume Next
    Dim ws As Worksheet, rngNames As Range, cell As Range, f As Range, firstAddress

    'Arbeistblatt festlegen  
    Set ws = ActiveSheet

    'Gruppierungsrange festlegen  
    Set rngNames = ws.Range("A1", ws.Cells(Rows.Count, 1).End(xlUp))  

    'Gruppierung aus dem Bereich vorher entfernen, für den Fall das das Makro später wiederholt werden soll  
    ws.Outline.ShowLevels RowLevels:=2
    rngNames.Rows.Ungroup

    ' Im Bereich nach 'Tag 1' suchen und Zellen gruppieren  
    With rngNames
        Set f = .Find("Tag 1", LookIn:=xlValues, Lookat:=xlWhole)  
        If Not f Is Nothing Then
            firstAddress = f.Address
            Do
                f.Resize(13).Rows.Group
                Set f = .FindNext(f)
            Loop While Not f Is Nothing And f.Address <> firstAddress
        End If
    End With

    ' den + Button für das Öffnen und Schließen der Gruppierung nach oben setzen  
    ws.Outline.SummaryRow = xlAbove

    ' Alle Gruppen reduziert anzeigen  
    ws.Outline.ShowLevels RowLevels:=1
End Sub