Dim wdTbl As Word.Table
    Dim xlApp As Excel.Application
    Dim xlWb As Excel.Workbook
    Dim xlWs As Excel.Worksheet
    Dim intTbl As Integer
    Dim rCount As Integer
    Dim cCount As Integer
       
    Set xlApp = New Excel.Application
    xlApp.Visible = True
    Set xlWb = xlApp.Workbooks.Add
    
    rCount =  1 
    cCount =  1 
    Set xlWs = xlWb.Worksheets( 1 )
    For Each wdTbl In ActiveDocument.Tables
        wdTbl.Range.Copy
        xlWs.Range("A" + CStr(rCount)).PasteSpecial (xlPasteValues)
        rCount = rCount + wdTbl.Rows.Count
        cCount = wdTbl.Columns.Count
    Next wdTbl

    'автоподбор ширины столбцов по содержимому
    For rCount =  1  To cCount
      xlWs.Columns(rCount).EntireColumn.AutoFit
    Next rCount
    Set xlApp = Nothing