Copy tables from Word to Excel

gailb
NewLounger
Posts: 21
Joined: 09 May 2020, 14:00

Copy tables from Word to Excel

Post by gailb »

Somewhat similar to my last request, Extract data after key word, in this request I would like to copy all the tables from one Word document to an Excel file. All tables should be copied to the first tab in Excel and stack one on top of the other.

All the tables look like the attachments
You do not have the required permissions to view the files attached to this post.

User avatar
HansV
Administrator
Posts: 67739
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Copy tables from Word to Excel

Post by HansV »

Here is a first attempt:

Code: Select all

Sub CopyTables2XL()
    Dim xlApp   As Object
    Dim xlWbk   As Object
    Dim xlWsh   As Object
    Dim xlRow   As Long
    Dim tbl     As Table

    On Error Resume Next
    Set xlApp = GetObject(Class:="Excel.Application")
    If xlApp Is Nothing Then
        Set xlApp = CreateObject(Class:="Excel.Application")
    End If
    On Error GoTo 0
    xlApp.Visible = True

    Set xlWbk = xlApp.Workbooks.Add(Template:=-4167)
    Set xlWsh = xlWbk.Worksheets(1)
    xlApp.ScreenUpdating = False
    xlRow = 1

    For Each tbl In ActiveDocument.Tables
        tbl.Range.Copy
        xlWsh.Range("A" & xlRow).Select
        xlWsh.PasteSpecial Format:="HTML"
        xlRow = xlRow + tbl.Rows.Count
    Next tbl
    xlApp.ScreenUpdating = True
End Sub
Regards,
Hans

gailb
NewLounger
Posts: 21
Joined: 09 May 2020, 14:00

Re: Copy tables from Word to Excel

Post by gailb »

Hi Hans,

This worked good, although, it appears not all the tables are lined up correctly so I get a debug error.

Example, a tables first row is shorter than the actual width of the table. Can some vba fix this?

User avatar
HansV
Administrator
Posts: 67739
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Copy tables from Word to Excel

Post by HansV »

If the tables aren't simple it might be complicated!

Could you post a sample document (without sensitive information) that demonstrates the problem?
Regards,
Hans

User avatar
HansV
Administrator
Posts: 67739
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Copy tables from Word to Excel

Post by HansV »

In the meantime, here is a second attempt:

Code: Select all

Sub CopyTables2XL()
    Dim xlApp   As Object
    Dim xlWbk   As Object
    Dim xlWsh   As Object
    Dim xlRow   As Long
    Dim tbl     As Table

    On Error Resume Next
    Set xlApp = GetObject(Class:="Excel.Application")
    If xlApp Is Nothing Then
        Set xlApp = CreateObject(Class:="Excel.Application")
    End If
    On Error GoTo 0
    xlApp.Visible = True

    Set xlWbk = xlApp.Workbooks.Add(Template:=-4167)
    Set xlWsh = xlWbk.Worksheets(1)
    xlApp.ScreenUpdating = False
    xlRow = 1

    Application.ScreenUpdating = False
    For Each tbl In ActiveDocument.Tables
        tbl.Range.Find.Execute FindText:=vbCr, ReplaceWith:="@@@@", Replace:=wdReplaceAll
        tbl.Range.Find.Execute FindText:=Chr(11), ReplaceWith:="$$$$", Replace:=wdReplaceAll
        tbl.Range.Copy
        xlWsh.Range("A" & xlRow).Select
        xlWsh.PasteSpecial Format:="HTML"
        xlRow = xlRow + tbl.Rows.Count
        tbl.Range.Find.Execute FindText:="$$$$", ReplaceWith:=Chr(11), Replace:=wdReplaceAll
        tbl.Range.Find.Execute FindText:="@@@@", ReplaceWith:=vbCr, Replace:=wdReplaceAll
    Next tbl
    Application.ScreenUpdating = True

    xlWsh.UsedRange.Replace What:="@@@@", Replacement:=vbLf, LookAt:=2
    xlWsh.UsedRange.Replace What:="$$$$", Replacement:=vbLf, LookAt:=2
    xlApp.ScreenUpdating = True
End Sub
Regards,
Hans

snb
3StarLounger
Posts: 241
Joined: 14 Nov 2012, 16:06

Re: Copy tables from Word to Excel

Post by snb »

VBA in Excel:

Code: Select all

Sub M_snb()
   with getobject("G:\OF\tabellen.docx")
     For Each it In .Paragraphs
       If Not it.Range.Information(12) Then it.Range.Delete
     Next
     .Content.Copy
   end with

  with thisworkbook.sheets(1)
    .Paste .cells(1)
  end with
End Sub

gailb
NewLounger
Posts: 21
Joined: 09 May 2020, 14:00

Re: Copy tables from Word to Excel

Post by gailb »

Hi Hans,

Here is a sample. I tested with a chopped up version (2 tables) and it worked, but with this version I get a paste fail.
You do not have the required permissions to view the files attached to this post.

User avatar
HansV
Administrator
Posts: 67739
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Copy tables from Word to Excel

Post by HansV »

Hi Gail,

I ran the macro from my previous reply against your sample document and it completed without error. Here is the resulting Excel workbook. You'd obviously want to widen the columns for a better result.

TablesFromWord.xlsx
You do not have the required permissions to view the files attached to this post.
Regards,
Hans

User avatar
HansV
Administrator
Posts: 67739
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Copy tables from Word to Excel

Post by HansV »

snb's code (to be run from Excel) works too, although it is slower, and it modifies the Word document. The result is comparable but slightly different (some Word cells have been split into multiple cells in Excel). See the attached version.

TablesFromWord_snb.xlsx
You do not have the required permissions to view the files attached to this post.
Regards,
Hans

gailb
NewLounger
Posts: 21
Joined: 09 May 2020, 14:00

Re: Copy tables from Word to Excel

Post by gailb »

Hi Hans and thanks for the reply.

When I run the code, I get the attached and it debugs to PasteSpecial Format:="HTML"
You do not have the required permissions to view the files attached to this post.

User avatar
HansV
Administrator
Posts: 67739
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Copy tables from Word to Excel

Post by HansV »

Perhaps you have a different version of Excel. Try this macro:

Code: Select all

Sub CopyTables2XL()
    Dim xlApp   As Object
    Dim xlWbk   As Object
    Dim xlWsh   As Object
    Dim xlRow   As Long
    Dim tbl     As Table

    On Error Resume Next
    Set xlApp = GetObject(Class:="Excel.Application")
    If xlApp Is Nothing Then
        Set xlApp = CreateObject(Class:="Excel.Application")
    End If
    On Error GoTo 0
    xlApp.Visible = True

    Set xlWbk = xlApp.Workbooks.Add(Template:=-4167)
    Set xlWsh = xlWbk.Worksheets(1)
    xlApp.ScreenUpdating = False
    xlRow = 1

    Application.ScreenUpdating = False
    For Each tbl In ActiveDocument.Tables
        tbl.Range.Find.Execute FindText:=vbCr, ReplaceWith:="@@@@", Replace:=wdReplaceAll
        tbl.Range.Find.Execute FindText:=Chr(11), ReplaceWith:="$$$$", Replace:=wdReplaceAll
        tbl.Range.Copy
        xlWsh.Paste Destination:=xlWsh.Range("A" & xlRow)
        xlRow = xlRow + tbl.Rows.Count
        tbl.Range.Find.Execute FindText:="$$$$", ReplaceWith:=Chr(11), Replace:=wdReplaceAll
        tbl.Range.Find.Execute FindText:="@@@@", ReplaceWith:=vbCr, Replace:=wdReplaceAll
    Next tbl
    Application.ScreenUpdating = True

    xlWsh.UsedRange.Replace What:="@@@@", Replacement:=vbLf, LookAt:=2
    xlWsh.UsedRange.Replace What:="$$$$", Replacement:=vbLf, LookAt:=2
    xlApp.ScreenUpdating = True
End Sub
Regards,
Hans

gailb
NewLounger
Posts: 21
Joined: 09 May 2020, 14:00

Re: Copy tables from Word to Excel

Post by gailb »

This version debugged to

xlWsh.Paste Destination:=xlWsh.Range("A" & xlRow)

My version of Excel is 2016

User avatar
HansV
Administrator
Posts: 67739
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Copy tables from Word to Excel

Post by HansV »

Does this happen with the sample document that you attached? I'm using Excel 2019 which is hardly different from Excel 2016, and both versions of the macro work fine for me...
Regards,
Hans

User avatar
HansV
Administrator
Posts: 67739
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Copy tables from Word to Excel

Post by HansV »

Wait - try starting Excel before running the macro. That shouldn't make a difference, but it appears to do so.
Alternatively, when you get the error message, click Debug, then press F5 to let the code continue (but that is rather clunky of course)
Regards,
Hans

gailb
NewLounger
Posts: 21
Joined: 09 May 2020, 14:00

Re: Copy tables from Word to Excel

Post by gailb »

Hi Hans, That seems to have done it. I opened the Excel file first and then ran the code. I stopped again so I debugged and then hit F5. It debugged again and then after hitting F5 again it fully ran.

User avatar
HansV
Administrator
Posts: 67739
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Copy tables from Word to Excel

Post by HansV »

Weird - but at least it works... :crazy:
Regards,
Hans