CODEWITHSUNDEEP
excelvbams-word
B.Cole
B.Cole

Reputation: 59

How to Export merged table from word to Excel using vba

I am having trouble exporting a merged word table to excel.

Here is my current code for a table that isn't merged.

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 (*.docm),*.docm", , _
"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
End If
Set wdDoc = Nothing

End Sub

This doesn't work for merged cells; when I run this script, it errors out when it finds a merged cell:

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

When I debug this is the line that is giving the issue: Cells(iRow, iCol) = WorksheetFunction.Clean(.Cell(iRow, iCol).Range.Text)

If I open a word doc without merged cells, it pulls in the data just fine. I need to pull data from a word doc with merged cells. Can the code be changed to do that?

Upvotes: 2

Views: 978

Answers (1)

David Zemens
David Zemens

Reputation: 53623

The problem with merged cells is that you end up in situations where .Columns.Count is more than the number of cells in the row, so you get an error like:

enter image description here

This should work and handles vertical merges, horizontal merges, or merges that are both vertical and horizontal, consider a Word Table like:

enter image description here

The code can be very simplified and doesn't loop over rows/columns/cells, just copy & paste the table using the (poorly documented) CommandBars.ExecuteMso method:

    .Tables(TableNo).Range.Copy
    Range("A1").Activate
    Application.DisplayAlerts = False
    Application.CommandBars.ExecuteMso "PasteDestinationFormatting"
    Application.DisplayAlerts = True

This is basically a simplified version of this similar answer but it unfortunately doesn't preserve merged cells:

enter image description here

If you'd like to preserve the formatting from Word, do :

.Tables(TableNo).Range.Copy
Range("A1").Activate
Application.CommandBars.ExecuteMso "PasteSourceFormatting"

And it should copy the formatting/etc:

enter image description here

If you need to preserve the merge areas but NOT the Word Formatting, then just apply the "Normal" style to the resulting range in Excel:

.Tables(TableNo).Range.Copy
Range("A1").Activate
Application.CommandBars.ExecuteMso "PasteSourceFormatting"
Range("A1").CurrentRegion.Style = "Normal"

enter image description here

Upvotes: 2

Related Questions