Split copy from non-adjoining Excel columns to non-adjoining Word table columns

Question

Would like to copy three ranges of data from Excel and then paste the three different ranges in an existing Word table. The Word document is generated from another program and the file name is different each time. I need to split the three ranges up and paste into the word table(1) but in columns that do not match the Excel copy. Current process is Copy one Excel range, alt+tab to Word document and paste into table, repeat for remaining two ranges. This is my copy code but I need the "paste" help.

Sub Copy_CV()
    Dim MaxVal As Long, C As Long

    MaxVal = Worksheets("Prop").Application.Max(Columns(2))
    C = MaxVal + 3
    Worksheets("Prop").Range("G4:G" & C).Select
    Worksheets("Prop").Range("L4:L" & C).Select
    Worksheets("Prop").Range("M4:M" & C).Select
    Selection.Copy
End Sub

Answer 1

You could do something like this:

Sub Copy_CV()
   Dim MaxVal As Long, C As Long

   MaxVal = Worksheets("Prop").Application.Max(Columns(2))
   C = MaxVal + 3

   'open Word with COM and late binding and open document
   Dim Word As Object, Document As Object, Table As Object
   Set Word = CreateObject("Word.Application")
   Set Document = Word.Documents.Open("example.docx")

   'get table
   Set Table = Document.Tables(1)

   'adjust rows
   dif = Table.Rows.Count - MaxVal
   If dif > 0 Then
    For i = 1 To dif
        Table.Rows(1).Delete
    Next
   ElseIf dif < 0 Then
    For i = 1 To -dif
        Table.Rows.Add
    Next
   End If

   'copy each col in excel and paste in col in the new table
   Worksheets("Prop").Range("G4:G" & C).Select
   Selection.Copy
   Table.Columns(1).Select 'this assumes that target rows are 1, 2 and 3
   Word.Selection.PasteAndFormat 16 'wdFormatOriginalFormatting=16

   Worksheets("Prop").Range("L4:L" & C).Select
   Selection.Copy
   Table.Columns(2).Select
   Word.Selection.PasteAndFormat 16

   Worksheets("Prop").Range("M4:M" & C).Select
   Selection.Copy
   Table.Columns(3).Select
   Word.Selection.PasteAndFormat 16

   'save and close document
   Document.Save
   Document.Close
   Word.Quit

   Set Table = Nothing
   Set Document = Nothing
   Set Word = Nothing
End Sub

This assumes you want to use the first table in your document. EDIT: added code to fix number of rows on target table.

Answer 2

Thanks for the response! Worked...kinda. Here's what I ran into, the code stops executing and hangs up on the Set Document line. After further consideration and your showing me possibilities, I have a couple of additional assistance requests. I only presented part of the process because I was only thinking one direction. The actual process is that 1) I copy and paste data from columns 5 and 6 of the Word table to Excel table G and L, 2) I adjust the data and generate column M then 3) I copy and paste Excel G, L and M back to Word table into columns 5, 6 and 7 then 4) since each Word column has unique formatting (has tabs which I could not duplicate) I have to select the title for each column and format each column using the format painter. I tried using macro recording to accomplish this but to without success because it would only format the first cell in the table.

Word Table - Generated from separate program but variable rows each time.

Request 1) Access the open instance of the word document...possibly have an error handler if it hangs up 2) Copy the data from Word table 1 columns 5 & 6 and paste in Excel table column G & L 3) Copy the data from Excel table columns G, L & M and paste into Word table 1 columns 5, 6 & 7. 4) Format Word table columns 5, 6 & 7 based on format of the table row 2 cells of each column.

Word Table 1

Sub Copy_CV() Dim MaxVal As Long, C As Long

   MaxVal = Worksheets("Prop").Application.Max(Columns(2))
   C = MaxVal + 3

  'open Word with COM and late binding and open document
   Dim Word As Object, Document As Object, Table As Object
   Set Word = CreateObject("Word.Application")
   Set Document = Word.Documents.Open("c:\test\Test.rtf")

   'get table
   Set Table = Document.Tables(1)
   '
   Worksheets("Prop").Range("G4:G" & C).Select
   Selection.Copy
   Table.Cell(Row:=3, Column:=5).Range.Select
   Word.Selection.Collapse
   Word.Selection.PasteAndFormat (wdTableOverwriteCells)

   'Copy ppa
   Worksheets("Prop").Range("L4:L" & C).Select
   Selection.Copy
   Table.Cell(Row:=3, Column:=6).Range.Select
   Word.Selection.Collapse
   Word.Selection.PasteAndFormat (wdTableOverwriteCells)

   'Copy klbs
   Worksheets("Prop").Range("M4:M" & C).Select
   Selection.Copy
   Table.Cell(Row:=3, Column:=7).Range.Select
   Word.Selection.Collapse
   Word.Selection.PasteAndFormat (wdTableOverwriteCells)

   'save and close document
   Document.Save
   Document.Close
   Word.Quit

   Set Table = Nothing
   Set Document = Nothing
   Set Word = Nothing
End Sub