Copy table from Word to Excel while preserving formatting

[excelshir]

I've been coding VBA for many years but this one is a real head-scratcher.


The task is simple - Copy data from a table from Microsoft Word to Microsoft Excel.


The challenge: Maintain the formatting of the data from Word, which includes bulleted lists and multiple paragraphs. More specifically, I need to include all that formatted text from a cell from the Word table inside a single cell in the corresponding Excel table.


Solutions I've already tried and specifically where I got stuck:


---
METHOD 01: Select the entire table in Word, select a single cell in Excel, and paste.


CODE:

Sub Method01_CopyAndPaste()


ActiveDocument.Tables(1).Select
Documents(1).ActiveWindow.Selection.Copy
Cells(1, 1).Select
ActiveSheet.Paste


End Sub

PROBLEM WITH METHOD 01: Excel creates multiple rows and merged cells whenever there are multiple paragraphs in the Word Table.


---
METHOD 02: Loop through the Word table, and assign all the contents to a Array (variant). Then loop through the Excel table and assign the values from the Array into the table.


CODE:

Sub Method02_Array()


Dim r As Integer
Dim c As Integer
Dim AryTblData(1 To 10, 1 To 10) As Variant


'Loop through the 10x10 Source table and assign all values to 2 dimensional array
For r = 1 To 10
    For c = 1 To 10
        AryTblData(r, c) = ActiveDocument.Tables(1).Cell(r + 1, c)
    Next c
Next r


'Paste the array values into the activesheet starting at cell(1,1)
For r = 1 To 10
    For c = 1 To 10
        Cells(r, c) = WorksheetFunction.Clean(AryTblData(r, c))
    Next c
Next r


End Sub

PROBLEM WITH METHOD 02: The formatting is not preserved. Specifically, the bullet points do not appear in the Excel table.


---
METHOD 03: Use

Application.Sendkeys

to simulate the process of manually going to one cell of the Word table, copying it, going to the corresponding cell in the Excel table, pasting it, pressing {TAB} to go to the next cell, and then repeating this process for the total number of cells in the table.


CODE:

Sub Method03_Sendkeys()


Dim r As Integer
Dim c As Integer


'Loop through the 3x3 Source table and simulate sending keys to copy and paste, cell by cell
For r = 1 To 3
    For c = 1 To 3
        
        'Activate Microsoft Word window
        AppActivate ("word"), True
        
        'Select the appropriate cell in the Word table (based on the For Loop)
        ActiveDocument.Tables(1).Cell(r, c).Select
        
        'In Word, copy the selection
        Application.SendKeys "^c", True
        
        'Activate Microsoft Excel window
            'Note: I'm not sure why AppActivate ("excel") does not work, but
            'for some reason Application.caption works for me.
        AppActivate Application.Caption, True
        
        'Select the appropriate cell in the active Excel worksheet (based on the For Loop)
        Cells(r, c).Select
        
        'In Excel, edit cell contents
        Application.SendKeys "{F2}", True
        
        'In Excel, Paste
        Application.SendKeys "^v", True
        
        'In Excel, Save changes to cell and move 1 cell to the right
        Application.SendKeys "{TAB}", True
    
    Next c
Next r


End Sub

PROBLEM WITH METHOD 03: It works with only 1 cell, but as soon as I attempt to get more than one cell copied and pasted over, the result is the same data over and over again across multiple cells.


----------


QUESTION: Is this task even possible to achieve in VBA? I'd love to find a simple and elegant solution, but at this point I would settle for something that WORKS.


Thanks so much for your help!


Shir

 

[Joshyd]

Perhaps you are overthinking it? could you just copy the table, go to excel, right click "paste special" and select HTML. That should retain everything.

 

[excelshir]

Thanks for the quick reply Joshyd! Unfortunately using paste special and choosing HTML has the same result of merging cells and adding new rows in Excel.