Word tables to a single Excel spreadsheet

[waterdog15]

All,
I am trying to import table(s) from word documents to a single excel spreadsheet. The word files contain a varying number of tables. I tried it myself and long story short, couldn't do it. I then searched on the web and found this web site and the macro below. The macro below orginally put each of the tables on its own sheet. I modified it and now it creates a new sheet and imports all of the tables to the same sheet but overwrites the previous table. I thought OK it must be in the for/next statement and tried to modify it.
I attempted to keep track of the total number of rows and have the for/next statement start with that number. For example if the 1st table had 5 rows, the for/next would be 1 to 5. If the 2nd table had 8, the for/next would be 6 to 13. If the 3rd table had 3, the for/next statement would be 14 to 16. I was hoping this would prevent overwriting the data in the sheet. I tried to do this several (0k about 30) different ways and could not get it write.

Can someone help me with the code? I think I can analyse it and figure out what I was doing wrong.

Thank-you for any help and this is an awesome website!
Paul


Sub ImportWordTable2()
'Import all tables to separate sheets
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
wdFileName = Application.GetOpenFilename("Word files (*.doc),*.doc", , _
"Browse for file containing table to be imported")
If wdFileName = False Then Exit Sub '(user cancelled import file browser)
Set wdDoc = GetObject(wdFileName) 'open Word file
With wdDoc
If wdDoc.tables.Count = 0 Then
MsgBox "This document contains no tables", _
vbExclamation, "Import Word Table"
Else
Sheets.Add after:=Sheets(Worksheets.Count)
For TableNo = 1 To wdDoc.tables.Count
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
On Error Resume Next
ActiveSheet.Cells(iRow, iCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)
On Error GoTo 0
Next iCol
Next iRow
End With
Next TableNo
End If
End With
Set wdDoc = Nothing
End Sub

 

[mikerickson]

Dim Pointer as Long
'...
[COLOR="DarkOrange"]Pointer = 0[/COLOR]
For TableNo = 1 To wdDoc.tables.Count
'...
    For iRow = 1 To .Rows.Count
        [COLOR="DarkOrange"]Pointer = Pointer + 1[/COLOR]
        For iCol = 1 To .Columns.Count
            On Error Resume Next
            ActiveSheet.Cells([COLOR="DarkOrange"]Pointer[/COLOR], iCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)
            On Error GoTo 0
        Next iCol
    Next iRow
'...
Next TableNo

 

[waterdog15]

Thank-you! I see what I was doing wrong. I put it in the wrong location.