Macro to import table from word file to successive rows or columns in excel

tryingtolovevba

New Member
Joined
Dec 22, 2014
Messages
1
Hi folks, as my name suggests I am fairly new to VBA and the world of macros but am already enjoying it :)

I wanted to develop a macro which will import a table or a part of a table from word files (user to be prompted for the location of the word file) in to a single excel worksheet on to successive columns in a single worksheet.

I have tried recording the action and tinkering around with it (as well using some stuff I found in the forum here) and while I am able to affect the open, copy & paste, I don't know to get the macro to use the next empty column on every instance of the macro button being pressed.

Any help would be greatly appreciated.

Sub ImportWordTable()
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 (*.docx),*.docx", , _
"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
If TableNo = 0 Then
MsgBox "This document contains no tables", _
vbExclamation, "Import Word Table"
ElseIf TableNo > 1 Then
TableNo = InputBox("This Word document contains " & TableNo & " tables." & vbCrLf & _
"Enter table number of table to import", "Import Word Table", "1")
End If
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
Cells(iRow, iCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)
Next iCol
Next iRow
End With
End With

Set wdDoc = Nothing

End Sub
 

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple

tlowry

Well-known Member
Joined
Nov 3, 2011
Messages
1,367
Congrats on your number 1 post to MrExcel.

I did a bit of "recoding" and came up with the following:

Code:
Sub ImportWordTable()
    Dim wdDoc
    Set wdDoc = GetObject("C:\Temp\tabler.doc")
    Dim tbNo
    tbNo = GetTableNo(wdDoc)
    If tbNo = 0 Then Exit Sub
    wdDoc.tables(tbNo).Range.Copy
    ActiveSheet.PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:=False
End Sub

Function GetTableNo(wdDoc) As Integer
    Dim tblct, TableNo
    GetTableNo = 0
    tblct = wdDoc.tables.Count
    Select Case wdDoc.tables.Count
        Case 0
            Exit Function
        Case 1
            GetTableNo = 1
        Case Else
            TableNo = InputBox("This Word document contains " & tblct & " tables." & vbCrLf & _
                "Enter table number of table to import", "Import Word Table", "1")
            [B][COLOR=#008000]If TableNo = False Then Exit Function
            If Not IsNumeric(TableNo) Then Exit Function
            TableNo = CInt(TableNo)
            If TableNo > tblct Then Exit Function[/COLOR][/B]
            GetTableNo = TableNo
    End Select
End Function

Note: I did some basic error checking on the table number input. It would be better to not let the user input a number, but "force" a correct selection, but that's another story...
 

Forum statistics

Threads
1,136,969
Messages
5,678,893
Members
419,787
Latest member
juanam

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top