Михаил задал вопрос:

Это можно сделать с помощью следующего макроса (ниже). Но предварительно создайте в корне диска папку Test, так как именно в нее будут сохранены новые документы с таблицами:

Sub SplitTables()
'Разбиение документа с таблицами на отдельные файлы,
'содержащие по одной таблице из документа
Dim iDoc As Long        'нумерация документов
Dim dDc1 As Document    ' активный документ
Dim dDc2 As Document    ' новый документ
Dim rTmp As Range       
Set dDc1 = ActiveDocument
For iDoc = 1 To dDc1.Tables.Count
   Set rTmp = ActiveDocument.Tables(iDoc).Range
   rTmp.Copy
   Set dDc2 = Documents.Add(Visible:=False)
   dDc2.Activate
   Selection.Paste
   dDc2.SaveAs "C:\Test\" & Format(iDoc, "000") & ".doc"
   dDc2.Close
Next
Set dDc1 = Nothing
Set dDc2 = Nothing
End Sub

]]> ]]>