Option Explicit

Sub Macro1()
'Graham Mayor - http://www.gmayor.com - Last updated - 22 Jul 2017
Const myKeyTerms As String = _
      "Aerospace, Space & Defence"
Dim oDoc As Document
Dim oTarget As Document
Dim oTable As Table
Dim oRng As Range
Dim oNew As Range
Dim oCell As Cell

    Set oDoc = ActiveDocument
    Set oTarget = Documents.Add
    oTarget.Range.Text = myKeyTerms & vbCr
    oTarget.Paragraphs(1).Range.Font.Bold = True
    If oDoc.Tables.Count = 0 Then
        MsgBox "No tables in this document?"
        GoTo lbl_Exit
    End If
    For Each oTable In oDoc.Tables
        Set oRng = oTable.Range
        With oRng.Find
            Do While .Execute(FindText:=myKeyTerms)
                If oRng.InRange(oTable.Range) Then
                    If oRng.Font.Bold = True Then
                        oRng.Start = oRng.Rows(1).Range.Next.Rows(1).Range.Start
                        oRng.End = oTable.Range.End
                        For Each oCell In oRng.Cells
                            If oCell.Range.Font.Bold = True Then
                                oRng.End = oCell.Range.Start
                                Exit For
                            End If
                        Next oCell
                        Exit Do
                    End If
                End If
                oRng.Collapse 0
            Loop
        End With
        Set oNew = oTarget.Range
        oNew.Collapse 0
        oNew.FormattedText = oRng.FormattedText
    Next oTable
lbl_Exit:
    Set oDoc = Nothing
    Set oTarget = Nothing
    Set oRng = Nothing
    Set oNew = Nothing
    Set oTable = Nothing
    Set oCell = Nothing
    Exit Sub
End Sub