Sub Macro1()
Dim oTable As Table
Dim oCell As Cell
Dim oRng As Range, oHeader As Range
Dim oColl As Collection
Dim i As Long
    Set oColl = New Collection
    For Each oTable In ActiveDocument.Tables
        For Each oCell In oTable.Range.Cells
            If InStr(1, oCell.Range.Text, "HELLO") > 0 Then
                Set oRng = oCell.Range
                oRng.End = oRng.End - 1
                Set oHeader = oCell.Range.Sections(1).Headers(wdHeaderFooterPrimary).Range
                oHeader.End = oHeader.End - 1

                Select Case True
                    Case InStr(1, oRng.Text, "APPLE") > 0
                        oColl.Add "I LIKE APPLES|" _
                                  & oRng.Text & "|" _
                                  & oHeader.Text & "|" _
                                  & oRng.Information(wdActiveEndPageNumber)
                    Case InStr(1, oRng.Text, "BANANA") > 0
                        oColl.Add "I DON'T LIKE BANANA|" _
                                  & oRng.Text & "|" _
                                  & oHeader.Text & "|" & _
                                  oRng.Information(wdActiveEndPageNumber)
                End Select
            End If
        Next oCell
    Next oTable
    Set oRng = ActiveDocument.Range
    oRng.Collapse 0
    oRng.InsertParagraphBefore
    Set oTable = ActiveDocument.Tables.Add(oRng, oColl.Count, 4)
    oTable.Columns(1).Width = CentimetersToPoints(4)
    oTable.Columns(2).Width = CentimetersToPoints(5)
    oTable.Columns(3).Width = CentimetersToPoints(4.5)
    oTable.Columns(4).Width = CentimetersToPoints(1.5)
    For i = 1 To oColl.Count
        oTable.Rows(i).Cells(1).Range.Text = Split(oColl(i), "|")(0)
        oTable.Rows(i).Cells(2).Range.Text = Split(oColl(i), "|")(1)
        oTable.Rows(i).Cells(3).Range.Text = Split(oColl(i), "|")(2)
        oTable.Rows(i).Cells(4).Range.Text = Split(oColl(i), "|")(3)
    Next i
lbl_Exit:
    Set oTable = Nothing
    Set oCell = Nothing
    Set oRng = Nothing
    Set oHeader = Nothing
    Set oColl = Nothing
    Exit Sub
End Sub