Extract Data from inconsistent number of rows

Please amend your sample file to show expected answers.

Added. Thank you.

If you wany the highlighted results returned... in the indicated format, I >>think<< this will be a nightmare if you're still using Excel 2016. It MIGHT be possible if the purple results werte all returned in a single row along with the yello header information... but it would still be a nightmare.

Are you OK with VBA? I won't be able to help... but others may. I can move the thread if VBA is a runner.

Moved. Good luck!!

Option Explicit

Sub demo()
Dim a, b, hdr
Dim lr As Long, r As Long, j As Long, n As Long
Dim ws1 As Worksheet, ws2 As Worksheet
hdr = Array("Accountable Operator", "Date", "Time", "Description")

Application.ScreenUpdating = False

Set ws1 = Sheets("Data")
Set ws2 = Sheets("Report")

ws1.Activate

lr = Cells(Rows.Count, "L").End(xlUp).Row
a = Range("A1:M" & lr)
ReDim b(1 To lr, 1 To 5)

For r = 1 To lr
    If a(r, 13) = "Accountable Operator" Then
        n = n + 1
        b(n, 1) = a(r + 1, 13)        ' Accountable Operator
        b(n, 2) = a(r + 1, 3)         ' Date
        b(n, 3) = a(r + 1, 4)         ' Time
    Else
       If a(r, 5) = "Decription" Then   ' DeScription ?)
          b(n, 4) = a(r + 1, 5)         ' Description
       Else
          If a(r, 8) = "Description" Then
            r = r + 1
             Do
                b(n, 5) = a(r, 8)
                n = n + 1
                r = r + 1
             Loop Until a(r, 5) = "Total Contents:"
             
          End If
       End If
    End If
Next r

With Sheets("Report")
    .Usedrange.clear
    .[A1].Resize(, 4) = hdr: .[A1].Resize(, 4).Font.Bold = True
    .[A2].Resize(n, 5) = b
    .Columns(1).Resize(, 5).AutoFit
End With

Application.ScreenUpdating = True

End Sub

Input sheet named "Data" and output is "Report" which has "RUN" button.

NOTE: heading in E is "Decription" not (as expected) "Description" so code (higlighted) needs amending for change in this title.

Another version with "Description" plus aligned Descriptions in single column

Option Explicit

Sub demo2()
Dim a, b, hdr
Dim lr As Long, r As Long, j As Long, n As Long
Dim ws1 As Worksheet, ws2 As Worksheet

hdr = Array("Accountable Operator", "Date", "Time", "Description")

Application.ScreenUpdating = False

Set ws1 = Sheets("Data")                           ' Input worksheet
Set ws2 = Sheets("Report")                         ' Output (Report) worksheet

ws1.Activate

lr = Cells(Rows.Count, "L").End(xlUp).Row          ' Last row of input data
a = Range("A1:M" & lr)                             ' Input data to array
ReDim b(1 To lr, 1 To 5)                           ' Dimension output array

For r = 1 To lr                                    ' Loop through input array
    If a(r, 2) = "Raised:" Then
        n = n + 1
        b(n, 1) = a(r, 13)                         ' Accountable Operator
        b(n, 2) = a(r, 3)                          ' Date
        b(n, 3) = a(r, 4)                          ' Time
    Else
       If a(r, 5) = "Description" Then             ' Column E
          b(n, 4) = a(r + 1, 5)                    ' Description
       Else
          If a(r, 8) = "Description" Then          ' Column H
            r = r + 1: n = n + 1
            Do
                b(n, 4) = a(r, 8)                   ' Descriptions
                n = n + 1: r = r + 1
             Loop Until a(r, 5) = "Total Contents:" ' End of "Description" data
             n = n - 1
          End If
       End If
    End If
Next r

With Sheets("Report")
    .UsedRange.Clear                                 ' Clear output
    .[A1].Resize(, 4) = hdr                          ' Headings
    .[A1].Resize(, 4).Font.Bold = True               ' "bold" headinfs
    .[A2].Resize(n, 5) = b                           ' Output reprt data
    .Columns(1).Resize(, 5).AutoFit                  ' Autofil columns
    .Activate
End With

Application.ScreenUpdating = True

End Sub

Macro is "Demo2"

try

Sub test()
    Dim a, x, i As Long, ii As Long, n As Long, r As Range
    If Not [isref(myresult!a1)] Then Sheets.Add(, Sheets("sheet4")).Name = "MyResult"
    With Sheets("sheet4")
        x = Filter(.[transpose(if(m1:m10000="accountable operator",row(1:10000)))], False, 0)
        If UBound(x) = 0 Then MsgBox "somthing is wrong": Exit Sub
        ReDim Preserve x(UBound(x) + 1)
        x(UBound(x)) = .Range("b" & Rows.Count).End(xlUp).Row
        ReDim a(1 To .Rows.Count, 1 To 4)
        For i = 0 To UBound(x) - 1
            n = n + 1
            a(n, 1) = .Cells(x(i) + 1, "m")
            a(n, 2) = .Cells(x(i) + 1, "c")
            a(n, 3) = .Cells(x(i) + 1, "d")
            a(n, 4) = .Cells(x(i) + 4, "e")
            If x(i + 1) - x(i) > 7 Then
                For ii = x(i) + 6 To x(i + 1) - 4
                    n = n + 1
                    a(n, 2) = "'" & .Cells(ii, "e")
                    a(n, 3) = "'" & .Cells(ii, "f")
                    a(n, 4) = .Cells(ii, "h")
                Next
            End If
        Next
    End With
    With Sheets("myresult").[a1:d1].Resize(n + 1)
        .CurrentRegion.Clear
        .Rows(1).Font.Bold = True
        .Rows(1).Value = [{"Accountable Operator","Date Raised","Time Raised","Description"}]
        .Rows(2).Resize(n) = a
        .Columns("b:d").Borders.Weight = 2
        For Each r In .Columns(1).SpecialCells(2, 2)
            r.Resize(, 4).Font.Bold = True
            r.Resize(, 4).BorderAround Weight:=3
        Next
        .BorderAround Weight:=3
        .EntireColumn.AutoFit
        .Parent.Select
    End With
End Sub

Edit:
Now I see what you meant by "Do not mind if this area is blank or if it repeats the line above"...

Perhab

Sub perhab()
Dim a, ar, i&,j&,n&
a = Sheets("Data").Range("A1:M" & Sheets("Data").cells(Rows.count,"L").End(3).row).value
Redim ar(1 to Ubound(a,1),1 to 5)
For i = 1 to Ubound(a,1)
 If a(i,13) = "Accountable Operator" then
  n = n + 1
  ar(n,1) = a(i+1,13)
  ar(n,2) = a(i+1,3)
  ar(n,3) = a(i+1,4)
 Elseif a(i,8) = "Description" then
   n = n + 1
   ar(n,4) = a(i+1,5)
   For j = i+1 to (i+1000)
     If j > Ubound(a,1) then exit for
     n = n + 1
     ar(n,4) = a(j,8)
     If a(j,5) = "Total Contents:" then exit for
   Next j
  n = n -1
 End if
Next i
With Sheets("Report")
.[A1].resize(,4).value =Array("Accountable Operator", "Date", "Time", "Description")
.[A2].resize(Ubound(ar,1),5).value = ar
End with
Erase ar
End sub

And so the options keep coming...

Sub J3v16()
Dim Data, Temp, i As Long, x As Long
With Sheets("Data")
    Data = .Range("B7:M" & .Cells(.Rows.Count, 12).End(xlUp).Row)
    ReDim Temp(1 To UBound(Data), 1 To 5)
End With
For i = 1 To UBound(Data)
    If Data(i, 1) = "Raised:" Then
        x = x + 1: Temp(x, 1) = Data(i, 12)
        Temp(x, 2) = Data(i, 2)
        Temp(x, 3) = Data(i, 3)
        Temp(x, 4) = Data(i + 3, 4)
        i = i + 2
    ElseIf Data(i, 7) = "Description" Then
        Do Until Data(i + 1, 4) Like "*Contents:"
            Temp(x, 5) = Data(i + 1, 7)
            x = x + 1: i = i + 1
        Loop
    End If
Next i
With Sheets("Report")
    .Cells(1, 1).Resize(, 4) = [{"Accountable Operator","Date","Time","Description"}]
    .Cells(2, 1).Resize(x, 5) = Temp
End With
End Sub