Sub GroupRow()
Dim i As Long, TotalRow As Long, CurNumber As Long, CurNumberRow As Long, NextNumber As Long, NextNumberRow As Long
On Error Resume Next
CurNumber = 1
CurNumberRow = 6
TotalRow = Application.WorksheetFunction.Match("Общий итог", Sheet1.Range("B:B"), 0)
Sheet1.Rows("6:" & CStr(TotalRow)).Select
For i = 1 To 9
      Selection.Rows.Ungroup
Next i
Err.Number = 0
Do
      NextNumber = CurNumber + 1
      NextNumberRow = Application.WorksheetFunction.Match(NextNumber, Sheet1.Range("A:A"), 0)
      If Err.Number <> 0 Then NextNumberRow = TotalRow
      Sheet1.Rows(CurNumberRow + 1 & ":" & NextNumberRow - 1).Select
      Selection.Rows.Group
      CurNumber = NextNumber
      CurNumberRow = NextNumberRow
      If CurNumberRow = TotalRow Then Exit Do
Loop
MsgBox "Rows regrouping process is complete", vbInformation, "Rows have been regrouped successfully"
End Sub