Thread: Macro to copy data within excel into tables in a word document

Hello all,

Currently I am going back and forth between an excel document and a word document cutting and pasting values from the excel spreadsheet into tables in word. The task is a regular occurance therefore I wish to create a Macro that can automate this procedure. Both the excel and word documents are fixed templates therefore once a Macro is created it can be applied to all future work of similar nature.

Each table in the word document contains 6 rows of values in a single column. The excel data is arranged in a table that is 6 rows by x number of columns (how ever many sets of values there are for the particular job) therefore x determines how many tables must exist in the word document. I move between the excel and word document cutting and pasting each column into each table. This is not so time consuming if x=10 however on occasion x=100+ and it does take time.

Would love to automate this.

Any help is much appreciated,

rpt21

Thanks Leith,

I almost have it working, it seems to bug at "wdTbl.Range.Cells(R).Range.Text = Rng.Cells(R, C)". I neglected to mention that each table in the word doc has 2 columns, the first with the data labels and the second where the values need to be inputted. The code began by putting the first column of data from excel into the first column and row of the first word table (A1) then B1 then A2 then B2 and so forth before stopping at the next table.

Also is it possible to keep number formats from excel?

much appreciated!

rpt21

Originally Posted by Leith Ross

Hello rpt21,

This macro runs from Excel. It lets the user select the Word document to open. I can change this to open a specific file, but I need to know the file path and document name. The data on "Sheet1" is assumed starts in column "A1:A6". The number of columns to the right are discovered automatically by the macro. The same number of tables are expected to exist in the Word document. The Excel cells are copied into each Word table. Copy this code into a VBA module in your Excel workbook.

Code:

Sub AutoFillWordTables()

  Dim C As Long
  Dim FileFilter As String
  Dim LastCol As Long
  Dim R As Long
  Dim Rng As Excel.Range
  Dim WordFile As String
  Dim wdApp As Object
  Dim wdDoc As Object
  Dim wdTbl As Object
  Dim Wks As Worksheet
  
    Set Wks = Worksheets("Sheet1")
    Set Rng = Wks.Range("A1:A6")
    
    LastCol = Wks.Cells(Rng.Row, Columns.Count).End(xlToLeft).Column
    Set Rng = Rng.Resize(ColumnSize:=LastCol)
    
      FileFilter = "Word Documents(*.doc),*.doc, All Files(*.*),*.*"
      WordFile = Excel.Application.GetOpenFilename(FileFilter)
    
      If WordFile = "False" Then Exit Sub
    
        Set wdApp = CreateObject("Word.Application")
        Set wdDoc = wdApp.Documents.Open(WordFile)
        
        For C = 1 To LastCol
          Set wdTbl = wdDoc.Tables(C)
            For R = 1 To Rng.Rows.Count
              wdTbl.Range.Cells(R).Range.Text = Rng.Cells(R, C)
            Next R
        Next C
        
       wdApp.Visible = True
    
    Set wdApp = Nothing
    Set wdDoc = Nothing
    Set wdTbl = Nothing
    
End Sub

Excellent thanks! It's functioning now, just hoping to keep the number formats (some are currency, some have 1 decimal places, some have 2 dp etc) and also only paste into every 4th table in the word document?

thanks again,

rpt21

Originally Posted by Leith Ross

Hello rpt21,

I changed the macro to copy the Excel data into the second column. The change is marked in blue.

Code:

Sub AutoFillWordTables()

  Dim C As Long
  Dim FileFilter As String
  Dim LastCol As Long
  Dim R As Long
  Dim Rng As Excel.Range
  Dim WordFile As String
  Dim wdApp As Object
  Dim wdDoc As Object
  Dim wdTbl As Object
  Dim Wks As Worksheet
  
    Set Wks = Worksheets("Sheet1")
    Set Rng = Wks.Range("A1:A6")
    
    LastCol = Wks.Cells(Rng.Row, Columns.Count).End(xlToLeft).Column
    Set Rng = Rng.Resize(ColumnSize:=LastCol)
    
      FileFilter = "Word Documents(*.doc),*.doc, All Files(*.*),*.*"
      WordFile = Excel.Application.GetOpenFilename(FileFilter)
    
      If WordFile = "False" Then Exit Sub
    
        Set wdApp = CreateObject("Word.Application")
        Set wdDoc = wdApp.Documents.Open(WordFile)
        
        For C = 1 To LastCol
          Set wdTbl = wdDoc.Tables(C)
            For R = 1 To Rng.Rows.Count
              wdTbl.Cell(R, 2).Range.Text = Rng.Cells(R, C)
            Next R
        Next C
        
       wdApp.Visible = True
    
    Set wdApp = Nothing
    Set wdDoc = Nothing
    Set wdTbl = Nothing
    
End Sub

yes correct

Originally Posted by Leith Ross

Hello rpt21,

Sorry, I forgot about the format part. Are you saying the macro needs to copy the data to every fourth table in the document?

Excellent thanks!

Originally Posted by Leith Ross

Hello rpt21,

I revised the macro to fill in every fourth table starting with first table in the document. The cells are now pasted from Excel into Word to preserve formatting.

Code:

Sub AutoFillWordTables()

  Dim C As Long
  Dim FileFilter As String
  Dim LastCol As Long
  Dim R As Long
  Dim Rng As Excel.Range
  Dim T As Integer
  Dim WordFile As String
  Dim wdApp As Object
  Dim wdDoc As Object
  Dim wdTbl As Object
  Dim Wks As Worksheet
  
    Set Wks = Worksheets("Sheet1")
    Set Rng = Wks.Range("A1:A6")
    
    LastCol = Wks.Cells(Rng.Row, Columns.Count).End(xlToLeft).Column
    Set Rng = Rng.Resize(ColumnSize:=LastCol)
    
      FileFilter = "Word Documents(*.doc),*.doc, All Files(*.*),*.*"
      WordFile = Excel.Application.GetOpenFilename(FileFilter)
    
      If WordFile = "False" Then Exit Sub
    
        T = 1
        Set wdApp = CreateObject("Word.Application")
        Set wdDoc = wdApp.Documents.Open(WordFile)
        
        For C = 1 To LastCol
          Set wdTbl = wdDoc.Tables(T)
            For R = 1 To Rng.Rows.Count
              wdTbl.Columns(2).Select
              Rng.Columns(C).Copy
              wdApp.Selection.Paste
            Next R
          T = T + 4
          If T > wdDoc.Tables.Count Then Exit For
        Next C
        
        Excel.Application.CutCopyMode = False
        wdApp.Visible = True
    
    Set wdApp = Nothing
    Set wdDoc = Nothing
    Set wdTbl = Nothing
    
End Sub