Count only AD sets

In cell 'C72' try;

Formula:

=IFERROR(IF(COUNTIFS(C6:C7,"A.D")>0,B72+1,IF(ISNUMBER(SUM(C6:C7)),"",0)),1)

Then pull across.

You can also pull down, but need to adjust the range as the range is 2 rows.
Conditional formatting to for red cells applied only to first 4 rows where I entered the formula for you.

Option Explicit

Sub demo4()

Dim a, b
Dim i As Long, j As Long, srow As Long, lrow As Long, orow As Long, n As Long

Application.ScreenUpdating = False

srow = 6: lrow = 67: orow = 72   ' <<<< change as required

n = 0

For i = srow To lrow - 1 Step 3
    For j = 3 To 44
        If IsEmpty(Cells(i, j)) Then
            Cells(orow, j) = 0
        Else
            If Cells(i, j) = "A.D" Or Cells(i + 1, j) = "A.D" Then
                n = n + 1
                Cells(orow, j) = n
            Else
                If IsNumeric(Cells(i, j)) And IsNumeric(Cells(i + 1, j)) Then
                    Cells(orow, j).Interior.Color = vbRed
                    n = 0                 
                 End If
             End If
        End If
    Next j
    orow = orow + 1
Next i

Application.ScreenUpdating = True

End Sub

Change the highlighted code as required.

Although John beat me to it, I post my solution anyway

You can also adjust the start of the Rows to analyze, and the row where the results start.

Option Explicit

Sub ADcount()

Dim vline1 As Long
Dim i As Long: Dim j As Long: Dim x As Long
Dim vStartRow As Long: Dim vResultRow As Long
Dim vCounter As Long: Dim lRow As Long

vStartRow = 6       ' << Start row to analyse
vResultRow = 72     ' << Start row for result
vCounter = 0
x = 44
lRow = Range("C" & Rows.Count).End(xlUp).Row

' Clear fprevious results
    Range("C" & vResultRow & ":AR80").Value = 0

' Loop through each 'Result' row;
    For j = vResultRow To lRow
    
' Loop through each column for each row;
        For i = 3 To x

            If Cells(vStartRow, i).Value = "A.D" Or Cells(vStartRow + 1, i).Value = "A.D" Then
                vCounter = vCounter + 1
                Cells(vResultRow, i).Value = vCounter
                    Else
                If Cells(vStartRow, i).Value = "" And Cells(vStartRow + 1, i).Value = "" Then
                Cells(vResultRow, i).Value = 0
                vCounter = 0
                    Else
                Cells(vResultRow, i).Value = ""
                vCounter = 0
            End If
          End If
        Next i
    
    vResultRow = vResultRow + 1     ' << move to the next 'result' row
    vStartRow = vStartRow + 3       ' << set next block of data 3 lines down
    
    Next j

End Sub