Удалить OutlineLevel (вертикальные свертки)

Sub test()
 Application.ScreenUpdating = False
i = 0
  For Each WAr In ActiveSheet.UsedRange.Rows
  i = i + 1
    If WAr.OutlineLevel = 4 Then ' 4 - поле для удаления. Возможно, что макрос нужно запустить несколько раз
      Rows(i & ":" & i).Select
      Selection.Delete Shift:=xlUp
    End If
  Next WAr
 Application.ScreenUpdating = True
End Sub

'Элегантное решение
Sub test()
' Application.ScreenUpdating = False
'i = 0


For i = 1 To 60
  If Rows(i).OutlineLevel = 2 Then Debug.Print Range("A" & i).Value
Next i

'
'  For Each WAr In ActiveSheet.UsedRange.Rows
'       If WAr.OutlineLevel = 4 Then Debug.Print 4
'  i = i + 1
'    If WAr.OutlineLevel = 4 Then ' 4ðàç
'      Rows(i & ":" & i).Select
'      Selection.Delete Shift:=xlUp
'    End If
'  Next WAr
' Application.ScreenUpdating = True
End Sub