Excel VBA Import Word table with merged cells to Excel

Question

I have many tables in a Word document (.docx) and I want to import them to a blank Excel sheet in an easy way. The tables in the Word document are not the same size (rows) and some rows have merged cells.

My code is below. I can choose the .docx and then select the number of the table to import but I only can import the headers, so I do not know if works fine. I am doing this because I want to keep the tables format (same rows) and is not valid if I use copy/paste.

When I run this code I get an error:

Run-time error '5941'. The requested member of the collection does not exist.

On this line:

Cells(iRow, iCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)

This is the code:

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),*.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
    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

The format of my tables is the following:

<header> Same number of rows for all
6 rows with 2 columns
</header>
<content of the table>
<header1>3 columns combined<header1>
multiple rows with 3 columns
<header1>3 columns combined<header1>
multiple rows with 3 columns
</content of the table>

Is something like this:

_______________________
|_________|____________|
|_________|____________|
|_________|____________|
|_________|____________|
|_________|____________|
|_________|____________|
|______________________|
|_____|__________|_____|
|_____|__________|_____|
|_____|__________|_____|
|_____|__________|_____|
|_____|__________|_____|
|______________________|
|_____|__________|_____|
|_____|__________|_____|
|_____|__________|_____|
|_____|__________|_____|
|_____|__________|_____|

Sorry for the table format but I do not know how to explain it better. The final goal is to leave it in excel as follows:

_______________________
|_________|____________|
|_________|____________|
|_________|____________|
|_________|____________|
|_________|____________|
|_________|____________|
|______________________||______________________|
|_____|__________|_____||_____|__________|_____|
|_____|__________|_____||_____|__________|_____|
|_____|__________|_____||_____|__________|_____|
|_____|__________|_____||_____|__________|_____|
|_____|__________|_____||_____|__________|_____|
|_____|__________|_____||_____|__________|_____|
|_____|__________|_____||_____|__________|_____|
|_____|__________|_____||_____|__________|_____|
|_____|__________|_____||_____|__________|_____|
|_____|__________|_____||_____|__________|_____|

How can I split the merged cells before insert in Excel? The steps would be to detect one by one as now the cells and when only found 1 split the cell or use as one

Answer 1

This is how I did it, I used the select command to select the table in word, and then pasted it into excel.

This will paste merged cells and all. From there, you can use the merge info in excel if you need to manipulate it further, clean the formatting or whatever else you need to do.

This example copies all tables out of a word doc into a new sheet for each table to the worksheet.

Sub CopyWordTables()        
    Dim wdDoc As Word.Document
    Dim wdFileName As Variant

    wdFileName = Application.GetOpenFilename("Word files (*.docx),*.docx", , _
    "Browse for word documents")

    If wdFileName = False Then
        Exit Sub
    End If

    Set wdDoc = GetObject(wdFileName)

    If wdDoc.Tables.Count = 0 Then
        MsgBox "There are no tables in the selected document."
        Exit Sub
    End If

    Dim intTableCount As Integer
    intTableCount = 1

    For Each Table In wdDoc.Tables
        Table.Select
        wdDoc.Application.Selection.Copy
        Set Sheet = Sheets.Add(After:=ActiveSheet)
        Sheet.Name = "Table " & intTableCount
        intTableCount = intTableCount + 1
        Sheet.Select
        ActiveSheet.Paste
    Next

    Set wdDoc = Nothing
End Sub

Answer 2

The error is caused because you cannot iterate through the cells of a table with merged cells by using SomeTable.Rows.Count and SomeTable.Columns.Count as 'grid references'.

This is because once you have horizontally merged one or more cells in a row, then the column count for that row decreases by n-1 where n is the number of merged cells.

So in your example table the column count is 3 but there is no column 3 in the first row hence the error.

You can use the Next method of the object returned by the Cell method on a Table object to iterate through the cell collection of the table. For each cell you can get the column and row indices and map them to Excel. However, for merged cells, you cannot get a column span property for each cell leaving you to need to look at Width properties to try and infer which cells are merged and by how much. In fact, it is going to be very difficult to recreate a Word table in an Excel worksheet where the table has lots of different cell widths and merging going on.

Here is an example of how to use the Next method:

Option Explicit

Sub Test()

    Dim rng As Range

    Set rng = ThisWorkbook.Worksheets("Sheet1").Range("A1")

    CopyTableFromDocx "D:\test.docx", rng

End Sub

Sub CopyTableFromDocx(strMSWordFileName As String, rngTarget As Range)

    Dim objDoc As Object
    Dim lngTableIndex As Long
    Dim objTable As Object
    Dim objTableCell As Object
    Dim lngRowIndex As Long, lngColumnIndex As Long
    Dim strCleanCellValue As String

    On Error GoTo CleanUp

    'get reference to word doc
    Set objDoc = GetObject(strMSWordFileName)

    'handle multiple tables
    Select Case objDoc.Tables.Count
        Case 0
            MsgBox "No tables"
            GoTo CleanUp
        Case 1
            lngTableIndex = 1
        Case Is > 1
            lngTableIndex = InputBox("Which table?")
    End Select

    'clear target range in Excel
    rngTarget.CurrentRegion.ClearContents

    'set reference to source table
    Set objTable = objDoc.Tables(lngTableIndex)

    'iterate cells
    Set objTableCell = objTable.Cell(1, 1)
    Do
        'get address of cell
        lngRowIndex = objTableCell.Row.Index
        lngColumnIndex = objTableCell.ColumnIndex

        'copy clean cell value to corresponding offset from target range
        strCleanCellValue = objTableCell.Range.Text
        strCleanCellValue = WorksheetFunction.Clean(strCleanCellValue)
        rngTarget.Offset(lngRowIndex - 1, lngColumnIndex - 1).Value = strCleanCellValue

        Set objTableCell = objTableCell.Next
    Loop Until objTableCell Is Nothing

    'success
    Debug.Print "Successfully copied table from " & strMSWordFileName

CleanUp:
    If Err.Number <> 0 Then
        Debug.Print Err.Number & " " & Err.Description
        Err.Clear
    End If
    Set objDoc = Nothing

End Sub

Which can import this table:

Like so, into a worksheet:

Note there is no unambiguous way AFAIK to solve the challenge around how to know that Bar3 should span merge Excel columns, or that we want Baz3 to be in cell D3, not C3.