Adjusting VBA for import word table into excel

[PC06 Finance]

Hello - I found this VBA module below to import world tables into Excel, but I have been trying to modify this to have 1 tab for each table in a document. I have been trying to add command lines like these 3 lines below but find myself either adding lots of blank tabs or putting myself into an infinite loop. Could I get some help?

Sheets.Add After:=.Sheets(.Sheets.Count)
Sheets(.Sheets.Count).Activate
Range("A1").Select

Sub ImportWordTable()
'Import all tables to a single sheet
Dim wdDoc As Object
Dim wdFileName As Variant
Dim TableNo As Integer 'table number in Word
Dim iRow As Long 'row index in Word
Dim jRow 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
jRow = 0
For TableNo = 1 To wdDoc.tables.Count
With wdDoc.tables(TableNo)
'copy cell contents from Word table cells to Excel cells
For iRow = 1 To .Rows.Count
jRow = jRow + 1
For iCol = 1 To .Columns.Count
On Error Resume Next
ActiveSheet.Cells(jRow, iCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)
On Error GoTo 0
Next iCol
Next iRow
End With
jRow = jRow + 1


Next TableNo
End If
End With
Set wdDoc = Nothing
End Sub

 

[Domenic]

In the future, please add code tags to your code. Assuming that your code is indented, it would make it easier to read. In any case, try replacing...

[COLOR=#333333]jRow = 0[/COLOR]
[COLOR=#333333]For TableNo = 1 To wdDoc.tables.Count[/COLOR]
[COLOR=#333333]   'etc
[/COLOR]   '
   '
[COLOR=#333333]Next TableNo[/COLOR]

with

    For TableNo = 1 To wdDoc.tables.Count
        Sheets.Add after:=Sheets(Sheets.Count)
        With wdDoc.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