Copy data from Single or Multiple Tables from Word to Excel using VBA

I have previously shared an article with an example showing how to open a word document from excel and copy excel data (a table) to the word doc using VBA. Here in this article I'll show you how to extract or copy data from single or multiple tables from a word document to your Excel worksheet.

Copy or Extract Table Data from Word to Excel using VBA

You can copy and paste tables from word to excel as it is. Its easy. However, if you are using VBA to automate your Excel job, then I am sure this example would come in handy.

Microsoft provides Table object (for word) in VBA, which has a collection of methods and properties with which you to read and extract data from multiple tables in a word doc, from Excel.

Let's see the example now.

First, create a word document (.doc or .docx) and draw a table. Add few rows to it. Make the first row as header. You can draw multiple tables in your word file. Save the file.

Now, open your Excel file and save the file in ".xlsx" format. Add a button, an ActiveX button control, in your worksheet (Sheet1).

Press Alt+F11 to open the VBA editor. You can also right click sheet1 and choose "View Code" option. Add Office Object Library Reference to your application.

Office Object Library Reference in Excel VBA

Write the below code inside the CommandButton1_Click() event.

Option Explicit

Private Sub CommandButton1_Click()
    copyTableDataFromWord
End Sub

Public Sub copyTableDataFromWord()
    On Error Resume Next
    
    ' Create a "FileDialog" object as a File Picker dialog box.
    Dim fd As Office.FileDialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    
    Dim sfileName As String
    
    With fd
        .AllowMultiSelect = False
        .Filters.Clear
        .Title = "Select a Word File"
        .Filters.Add "All Word Documents", "*.doc?", 1
    
        If .Show = True Then
            sfileName = Dir(.SelectedItems(1))      ' Get the file.
        End If
    End With
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    If Trim(sfileName) <> "" Then
        Dim objWord As Object       ' Create a Word object.
        Set objWord = CreateObject("Word.Application")
        objWord.Visible = False      ' Do not show the file.
        
        ' Create a Document object and open the Word file.
        Dim objDoc
        Set objDoc = objWord.Documents.Open(fd.InitialFileName & sfileName)
            
        Dim iTable      ' The table that you want to extract data.
        iTable = 1      ' Set value as 2 or 3 for second or third table (if any).
        
        ' Note: If you have multiple tables in your word file,
        '  use "objDoc.tables.Count" to get the total tables in the file
        '  and loop through each table.
        
        If objDoc.tables(iTable).Columns.Count > 0 Then     ' Check if it’s a table.
        
            Dim iTotalCols As Integer   ' Get total columns in the table.
            iTotalCols = objDoc.tables(iTable).Columns.Count
            
            Dim iTotalRows As Integer   ' Get total rows in the table.
            iTotalRows = objDoc.tables(iTable).Rows.Count
            
            Dim iRows, iCols As Integer
            Dim txt As Variant
            
            ' Get the table headers first.
            For iCols = 1 To objDoc.tables(iTable).Columns.Count
                txt = objDoc.tables(iTable).cell(1, iCols).Range.Text
                With Sheet1
                    .Cells(1, iCols) = Replace(txt, " ", "")          ' Write the headers in sheet1.
                    .Cells(1, iCols).Font.Bold = True
                End With
            Next iCols
    
            ' Now extract the table data.
            For iRows = 2 To iTotalRows
                For iCols = 1 To iTotalCols
                    txt = objDoc.tables(iTable).cell(iRows, iCols).Range.Text
                    Sheet1.Cells(iRows, iCols) = Replace(txt, " ", "")   ' Show data in sheet1.
                Next iCols
            Next iRows
        End If
        
        ' Add borders to the table.
        Sheet1.UsedRange.Borders.LineStyle = xlContinuous
    End If
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
    ' Clean up.
    objWord.Close
    objDoc.Quit
    Set objWord = Nothing
    Set objDoc = Nothing
End Sub

I am using the FileDialog object in the procedure to select the word file. After getting access to the word file, I am creating twoobject, "word" and "doc", to open and read the contents in the file. The word doc will remain invisible.

objWord.Visible = False ' Do not show the file.

The tables() method of Table object, will allow us read the doc’s table data. The method takes one parameter as "index", a number, which will return a single table object.

tables(index)

You can define the index values like 1, 2, 3 etc. depending upon the number of tables you want to read and extract data from. However, If you have multiple tables in your word file, and don’t want to add indexes manually, you can use objDoc.tables.Count to get the total tables in the file and loop through each table.

After writing the data to the Excel worksheet, I am just drawing borders around the columns and rows.

Sheet1.UsedRange.Borders.LineStyle = xlContinuous ' Add borders to the table.

← PreviousNext →