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