treeleaf20
Board Regular
- Joined
- Mar 17, 2009
- Messages
- 154
All,
I have the following code, this works great as it pulls in all the information from some of my word documents and cycles through all the tables I have in my word document. The problem is it stays in the original cell and it keeps overwriting the previous data. If the table has 2 columns and nine rows. I'd like each row to populate and then when it's done move to row 10. Here is the code. Any suggestions would be very helpful. Thanks in advance:
I have the following code, this works great as it pulls in all the information from some of my word documents and cycles through all the tables I have in my word document. The problem is it stays in the original cell and it keeps overwriting the previous data. If the table has 2 columns and nine rows. I'd like each row to populate and then when it's done move to row 10. Here is the code. Any suggestions would be very helpful. Thanks in advance:
Code:
Sub ImportWordTable1()
'Import one table to current sheet
Dim wdDoc As Object
Dim WS As Worksheet
Dim wdFileName As Variant
Dim TableNo As Integer 'table number in Word
Dim currentTable As Integer
Dim d As Integer
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
TableNo = wdDoc.Tables.Count
currentTable = 1
For d = 0 To TableNo
With .Tables(currentTable)
'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
Cells(iRow, iCol) = WorksheetFunction.Clean(.Cell(iRow, iCol).Range.Text)
'Sheet2.Range("a" & .Rows.Count).End(xlUp).Offset(1).Resize(, 1) = _
Array(wdDoc.Tables(currentTable).Cell(1, 2))
On Error GoTo 0
Next iCol
Next iRow
'Set WS = Sheets.Add
End With
currentTable = currentTable + 1
Next d
End With
Set wdDoc = Nothing
End Sub