Sub Main()
Dim TOC As TableOfContents
With ActiveDocument
  For Each TOC In .TablesOfContents
    TOC.Delete
  Next
  .Fields.Unlink 
  Call MoveTablesToNewDocument
  With .Content.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "^b"
    .Replacement.Text = ""
    .Execute Replace:=wdReplaceAll
    .Text = "^~"
    .Replacement.Text = "-"
    .Execute Replace:=wdReplaceAll
  End With
End With
End Sub

Sub MoveTablesToNewDocument()
Dim SrcDoc, NewDoc As Document
Dim SrcDocTableRange As Range
Set SrcDoc = ActiveDocument
If SrcDoc.Tables.Count <> 0 Then
  Set NewDoc = Documents.Add(DocumentType:=wdNewBlankDocument)
  Set NewDocRange = NewDoc.Range
  Dim PrevPara As Range
  Dim NextPara As Range
  Dim NextEnd As Long
  NextEnd = 0
  With NewDocRange
    For Each SrcDocTable In SrcDoc.Tables
      Set SrcDocTableRange = SrcDocTable.Range
      'output the preceding paragraph?
      Set PrevPara = SrcDocTableRange.Previous(wdParagraph, 1)
      If PrevPara Is Nothing Or PrevPara.Start < NextEnd Then
      Else
        Set PPWords = PrevPara.Words
        If PPWords.Count > 1 Then 'yes
          .Start = NewDocRange.End
          .InsertParagraphBefore
          .Start = NewDocRange.End
          .InsertParagraphBefore
          .FormattedText = PrevPara.FormattedText
        End If
      End If
      'output the table
      .Start = .End
      .FormattedText = SrcDocTableRange.FormattedText
      'output the following paragraph?
      Set NextPara = SrcDocTableRange.Next(wdParagraph, 1)
      If NextPara Is Nothing Then
      Else
        Set PPWords = NextPara.Words
        NextEnd = NextPara.End
        If PPWords.Count > 1 Then 'yes
          .Start = .End
          .InsertParagraphBefore
          .FormattedText = NextPara.FormattedText
        End If
      End If
      SrcDocTableRange.Delete
    Next SrcDocTable
  End With
End If
End Sub