Sub Table_Word()
Dim WordApp As Word.Application
Dim DocWord As Word.Document
Dim TableWord As Word.Table
Dim objExc As New Excel.Application
Dim i As Integer
Dim r As Integer 'количество столбцов в таблице

Set WordApp = New Word.Application
Set DocWord = WordApp.Documents.Open("I:\1.doc")
objExc.Workbooks.Add
objExc.Range("a1").Select
WordApp.Visible = True
objExc.Visible = True
DocWord.Activate
Set TableWord = DocWord.Tables( 1 )
For i =  0  To TableWord.Range.Rows.Count
On Error Resume Next
   DoEvents
    For r =  1  To  6 
            objExc.ActiveCell.Offset( 0 , r).Value = TableWord.Cell(i, r).Range.Text
    Next r
  objExc.ActiveCell.Offset( 1 ,  0 ).Select
Next i
Set WordApp = Nothing
Set objExc = Nothing
End Sub