VBA Copy text from tables in word doc to excel?

Question

I have a word document:

Table 1

A      A
B      B

Table 2

C      C
D      D

I am trying to copy each piece of text from my tables in a word document to cells in excel like so:

Excel:

Column A      Column B
A             A
B             B
C             C
D             D

The code below is only copying the last table in my word document. Producing this result:

Excel:

Column A     Column B
C            C
D            D

Here's my code:

Sub ImportWordTable()
Dim objWord As Object
Dim wdDoc As Object
Dim wdFileName As Variant
Dim TableNo As Integer 'table number in Word
Dim iRow As Long 'row index in Excel
Dim iCol As Integer 'column index in Excel

Set objWord = GetObject(, "Word.Application")

Set wdDoc = objWord.ActiveDocument

With wdDoc
TableNo = wdDoc.tables.Count
    If .tables.Count > 0 Then
    With .tables(TableNo)
        'copy cell contents from Word table cells to Excel cells
        For iRow = 1 To .Rows.Count
            For iCol = 1 To .Columns.Count
                Cells(iRow, iCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)
            Next iCol
        Next iRow
    End With
    End If
End With

Set wdDoc = Nothing

End Sub

Please can someone show me where I am going wrong? I think i need to add a for each loop for TableNo

Something like

For Each TableNo In wdDoc
Next TableNo

Subodh Tiwari sktneer Subodh Tiwari sktneer · Accepted Answer · 2017-06-02T12:34:15

You are looping through the cells within the one table only whereas you also need to loop through the each table on the document.

You may try something like this...

Sub ImportWordTable()
Dim objWord As Object
Dim wdDoc As Object
Dim wdFileName As Variant
Dim TableNo As Integer 'table number in Word
Dim iRow As Long 'row index in Excel
Dim iCol As Integer 'column index in Excel
Dim i As Long
Dim r As Long, c As Long
Set objWord = GetObject(, "Word.Application")

Set wdDoc = objWord.ActiveDocument
r = 1
c = 1
With wdDoc
TableNo = wdDoc.tables.Count
    If .tables.Count > 0 Then
        For i = 1 To TableNo
            With .tables(i)
                'copy cell contents from Word table cells to Excel cells
                For iRow = 1 To .Rows.Count
                    For iCol = 1 To .Columns.Count
                        Cells(r, c) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)
                        c = c + 1
                    Next iCol
                    c = 1
                    r = r + 1
                Next iRow
            End With
            c = 1
        Next i
    End If
End With
Set wdDoc = Nothing
End Sub

VBA Copy text from tables in word doc to excel?

1 Answers