Public Sub WordTablesToExcel()
    Dim wdTbl As Word.Table
    Dim xlApp As Excel.Application
    Dim xlWb As Excel.Workbook
    Dim xlWs As Excel.Worksheet
    Dim intTbl As Integer
       
    Set xlApp = New Excel.Application
    xlApp.Visible = True
    Set xlWb = xlApp.Workbooks.Add
    
    For Each wdTbl In ActiveDocument.Tables
        wdTbl.Range.Copy
        Set xlWs = xlWb.Worksheets.Add
        xlWs.Paste
    Next wdTbl

    Set xlApp = Nothing
End Sub

Public Sub WordTablesToExcel()
    Dim wdTbl As Word.Table
    Dim wdCell As Word.Cell
    Dim xlApp As Excel.Application
    Dim xlWb As Excel.Workbook
    Dim xlWs As Excel.Worksheet
    Dim intTbl As Integer
    Dim fIsLikeFt As Boolean
       
    Set xlApp = New Excel.Application
    xlApp.Visible = True
    Set xlWb = xlApp.Workbooks.Add
    
    For Each wdTbl In ActiveDocument.Tables
        fIsLikeFt = True
        
        For Each wdCell In wdTbl.Columns( 1 ).Cells
            If Not wdCell.Range Like "FT-*" Then
                fIsLikeFt = False
                Exit For
            End If
        Next wdCell
        
        If fIsLikeFt Then
            wdTbl.Range.Copy
            Set xlWs = xlWb.Worksheets.Add
            xlWs.Paste
        End If
    Next wdTbl

    Set xlApp = Nothing
End Sub