Option Explicit
Sub grupping()
                  Dim ra As Range, cell As Range
              Dim pos_dir(100) As Integer
              Dim pos_upr(500) As Integer
              Dim i, j As Integer
              Set ra = Selection
                        
              For Each cell In ra.Cells
                  If cell.Value Like "Дирекция" Then
                      pos_dir(cell) = cell.Row
                  End If
                  If cell.Value Like "Управление" Then
                      If pos_upr(cell) < pos_dir(cell) Then
                          pos_upr(cell) = cell.Row
                      End If
                  End If
              Next cell
                        
              i = 1
              j = 1
              While i < UBound(pos_dir)
                  Range(Cells(pos_dir(i), 1), Cells(pos_dir(i + 1) - 1, 10)).Select
                  Selection.Rows.Group
                  While j < UBound(pos_upr)
                      Range(Cells(pos_upr(j), 1), Cells(pos_upr(j + 1) - 1, 10)).Select
                      Selection.Rows.Group
                      j = j + 1
                  Wend
                  i = i + 1
              Wend
End Sub