Sub CopyTables()
Application.ScreenUpdating = False
Dim DocSrc As Document, DocTgt As Document, Tbl As Table, Rng As Range
Set DocSrc = ActiveDocument: Set DocTgt = Documents.Add
For Each Tbl In DocSrc.Tables
  Set Rng = DocTgt.Characters.Last
  With Rng
    .Collapse wdCollapseEnd
    .FormattedText = Tbl.Range.FormattedText
    .Tables(1).Style = "Table Grid"
    .Collapse wdCollapseEnd
    .InsertAfter vbCr
  End With
Next
Set DocSrc = Nothing: Set DocTgt = Nothing
Application.ScreenUpdating = True
End Sub