Удаление лишних строк - доделать макрос

удаляем шапку и описание
 
Dim intRow As Long
Dim intLastRow As Long
 
intLastRow = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1
 
For intRow = intLastRow To 1 Step -1
    If InStr(ActiveSheet.Cells(intRow, 1), "   Блок") > 0 Then
        For i = intRow To intRow + 9
            ActiveSheet.Rows(intRow).Delete
        Next i
    End If
 
'далее надо как-то (наверно, через Do/While) добавить поиск и удаление описания
'логика: найти "   Блок", от него вверх, пока не встретится номер страницы (ячейка длиной не больше 5, содержащая цифры)
'при этом надо как-то совместить код с предыдущим куском
 
'    If Len(Cells(i, 1)) <= 5 Then
'        If Cells(i, 1) Like "*[0-9]*" Then
'
'        End If
'    End If
 
NextIntRow:
Next intRow

Sub Ixet08()
Const BLK$ = "   Блок:"
Dim i&, s$, c As Range, j&
  i = Cells(Rows.Count, 1).End(xlUp).Row
new_find:
    Set c = Range("A:A").Find(BLK, Cells(i, 1), xlValues, xlPart, , xlPrevious)
    If c Is Nothing Then Exit Sub
    s = c
    c.Offset(10, 1).Value = Val(Mid$(s, InStr(s, BLK) + 8))
    For i = c.Row - 1 To 1 Step -1
      s = Cells(i, 1)
      If Len(s) <= 5 Then
        For j = 1 To Len(s)
          If Not Mid$(s, j, 1) Like "*[0-9]*" Then GoTo nxt_i
        Next
        Range(Rows(i), Rows(c.Row + 9)).Delete
        GoTo new_find
      End If
nxt_i:
    Next i
End Sub