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 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
End Sub