Sub iЗаголовок()
Dim iLastRow As Long
Dim iText As String
Dim FRow As Integer
Dim ERow As Integer
Dim FoundCell As Range
Dim FAdr As String
Dim i As Integer
Dim n As Integer
    iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
    Range("N8:N" & iLastRow).ClearContents   'очищает столбец с результатом
  Set FoundCell = Columns("A:G").Find("Заголовок", , xlValues, xlPart)
   If Not FoundCell Is Nothing Then
      FAdr = FoundCell.Address            'адрес первого вхождения Заголовка
    Do
      iText = FoundCell.Text              'Заголовок с номером
      FRow = FoundCell.Row + 1            'первая строка после Заголовка
        Set FoundCell = Columns("A:G").Find("Заголовок", After:=FoundCell)
        If FoundCell.Address = FAdr Then
          ERow = iLastRow                 'последняя строка в диапазоне между Заголовками
        Else
          ERow = FoundCell.Row - 1
        End If
          n = 0
        For i = FRow To ERow              'цикл в диапазоне для подсчета количества окрашенных строк
          If Cells(i, "A").Interior.ColorIndex = Range("A8").Interior.ColorIndex Then n = n + 1
        Next
        Cells(FRow - 1, "N") = iText & " кол-во красных строк: " & n    'вывод результата в столбец N
    Loop While FoundCell.Address <> FAdr
   End If
End Sub