If InStr(aRng.Text, "Worksheet") > 0 And InStr(aTbl.Range.Cells(aTbl.Range.Cells.Count).Range.Text, "n/a") = 0 Then

Sub Results2()
  Dim i As Integer, iTables As Integer
  Dim aTbl As Table, tblLast As Table, tblTgt As Table, aCellTgt As Cell
  Dim aRng As Range, aRngEnd As Range, aRngSource As Range
  
  iTables = ActiveDocument.Tables.Count
  Set tblLast = ActiveDocument.Tables(iTables)
  Set tblTgt = tblLast.Tables(2)
  Set aCellTgt = tblTgt.Cell(1, 2)
  aCellTgt.Range.Text = ""    'if you want to start with a blank cell
  
  For i = 1 To iTables - 1
    Set aTbl = ActiveDocument.Tables(i)
    Set aRng = aTbl.Range.Cells(1).Range
    If InStr(aRng.Text, "Worksheet") > 0 And InStr(aTbl.Range.Cells(aTbl.Range.Cells.Count).Range.Text, "n/a") = 0 Then
      Set aRngSource = aTbl.Range.Cells(aTbl.Range.Cells.Count).Range
      aRngSource.MoveEnd Unit:=wdCharacter, Count:=-1
      Set aRngEnd = aCellTgt.Range
      aRngEnd.Collapse Direction:=wdCollapseEnd
      aRngEnd.MoveEnd Unit:=wdCharacter, Count:=-1
      aRngEnd.FormattedText = aRngSource.FormattedText
      aRngEnd.InsertAfter vbCr & vbCr
    End If
  Next i
  tblLast.Tables(2).Cell(1, 2).Select
  With Selection.Font
    .Bold = False
    .Name = "Times New Roman"
    .Size = 10
    .ColorIndex = wdBlack
    With aCellTgt.Range
        .ParagraphFormat.SpaceAfter = 0
        .ParagraphFormat.SpaceBefore = 0
    End With
  End With
  tblLast.Tables(2).Cell(1, 2).Select
    Selection.HomeKey Unit:=wdLine
    Selection.TypeParagraph
  tblLast.Tables(2).Cell(1, 2).Select
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.Text = "Methodology"
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    Selection.MoveRight Unit:=wdCharacter, Count:=2
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.Text = "The following methodologies were used in the examination of this case:"
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    Selection.MoveRight Unit:=wdCharacter, Count:=2
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.Text = "Visual Examination"
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    Selection.MoveRight Unit:=wdCharacter, Count:=2
    Selection.TypeParagraph
    Selection.Text = "Physical Examination"
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    Selection.MoveRight Unit:=wdCharacter, Count:=2
    Selection.TypeParagraph
    Selection.Text = "Physical Measurements"
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    Selection.MoveRight Unit:=wdCharacter, Count:=2
    Selection.TypeParagraph
    Selection.Text = "Microscopic Examination"
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    Selection.MoveRight Unit:=wdCharacter, Count:=2
    Selection.TypeParagraph
    Selection.Text = "Microscopic Comparison"
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    Selection.MoveRight Unit:=wdCharacter, Count:=2
    Selection.TypeParagraph
    Selection.Text = "Database Search"
    
  Dim p As Integer, pParagraph As Integer
  Dim r As Range
  tblLast.Tables(2).Cell(1, 2).Select
  pParagraph = Selection.Paragraphs.Count
  tblLast.Tables(2).Cell(1, 2).Range.InsertParagraphAfter
    For p = 1 To pParagraph
      Set aParagraph = tblLast.Tables(2).Cell(1, 2).Range.Paragraphs(p)
      Set aRng = aParagraph.Range
        If InStr(aRng.Text, "Result") > 0 Then
            aRng.Select
            With Selection.Font
                .Bold = True
            End With
        End If
        If InStr(aRng.Text, "Result") = 0 Then
            aRng.Select
            Selection.Paragraphs.LeftIndent = 18
        End If
        If InStr(aRng.Text, "Methodology") > 0 Then
            aRng.Select
            With Selection.Font
                .Bold = True
            End With
            Selection.Paragraphs.LeftIndent = 0
        End If
    Next p
  Selection.Document.Undo
  Selection.Paragraphs.LeftIndent = 18
  Selection.EndKey Unit:=wdLine
  Selection.MoveDown Unit:=wdLine, Count:=1
  Selection.TypeBackspace
  
End Sub