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
For TableNo = 1 To wdDoc.tables.Count
With .tables(TableNo)
Sheets.Add after:=Sheets(Worksheets.Count)
'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
No comments:
Post a Comment