export word tables into excel

[sakura.saki]

Hi,
I am now having a word document with 30 tables without certain length. every table has only 1 columns. I found a code for excel which opens a word document and import the tables into a certain excel sheet. it works perfectly except:it imports all the 30 tables into the excel sheet one below another, in my case, all of them is in one column : A column and it is over 400 rows long. But I would like that, that the tables to be imported in adjucent columns one after another: the first table in column A, second in B, third in C and so on...

can anyone change the code a little so that it works in the way I want?thanks!
here the code:
Sub importwordtoexcel()

'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 .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
Sheets("Teams").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

[snb]

Sub snb()
j = 1
For Each tb In GetObject("G:\OF\__tables.docx").tables
tb.Range.Copy
Sheets(1).Paste Cells(1, j)
j = j + 1
Next
End Sub

[sakura.saki]

thanks snb, I have a further question: I know if I change the right path to your code, it works. I have tried it. but what if I still want to keep the part which the window pop up and let me to choose the word document? I tried to change your code into the following but I get an error message Sub snb()
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)
j = 1
For Each tb In wdDoc.tables
tb.Range.Copy
Sheets(1).Paste Cells(1, j)
j = j + 1
Next
End Sub

[snb]

Sub snb()
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)


j=1

For Each tb In GetObject(wdFileName).tables

tb.Range.Copy
Sheets(1).Paste Cells(1, j)
j = j + 1
Next
End Sub





or even:


Sub snb()
On Error Resume Next

j = 1
For Each tb In GetObject(Application.GetOpenFilename("Word files (*.doc),*.doc", , "Browse for file containing table to be imported")).tables
tb.Range.Copy
Sheets(1).Paste Cells(1, j)
j = j + 1
Next
End Sub


NB. check whether wdfilename is the fullname (Path & name & extension)

[sakura.saki]

thanks snb!it is very nice of you!:clap: