Copy-Paste A Filtered Excel Table into Word

Hi,


I'm looking for a script that will auto-filter my Excel table by CustomerNumber then automatically copy and paste the filtered table into a Word doc. template I have saved on my computer (i.e. by defining a specific file pathway)

Once this has been done, I need the code to save and close the populated word template and move on to the next customer in my original excel table (i.e. the next unique customer number) and repeat the process so I am able to generate a unique word document from my template for each customer, with their specific details after filtering.

I've been researching auto-filter code, similar to the script below but can't get it execute within my code correctly.

Code:

---

For i = 1 To collUniqueHeadings.Count
    With wsSource
        .Range("A1").AutoFilter Field:=2, Criteria1:=collUniqueHeadings(i)
        .Range("A1:D" & lngLastRow).Copy
    End With
    With appWord.Selection
        .PasteExcelTable linkedtoexcel:=False, wordformatting:=True, RTF:=False
        .TypeParagraph
    End With
Next i

---

I've attached a workbook with an example of my data table and the code I've written so far.

Any help would be greatly appreciated.

Thanks,
Rex

Attachment 23010

The code you've posted lacks context (e.g. we have no idea what collUniqueHeadings refers to).

In any event, auto-filtering your workbook will not do what you want because, with your workbook's setup, auto-filtering would only return one row per CustomerNumber. Instead, you need to loop through the rows so you can either send the rows for a given CustomerNumber to Word one at a time, or copy & paste them as a block.

Hi Paul,

Thanks for the feedback. Sorry for the lack of context, I originally input the code to give a general idea of the route I was researching to achieve my goal.

Regarding your feedback on the 'auto-filter' route, can you expand on looping through the rows and 'copy & pasting them as a block?' Any script/pointers you could provide on looping through each row and capturing each CustomerNumbers model & price and then having that table 'copy and pasted as a block' to my Word template would be very much appreciated.

Many Thanks,
Rex

Try:

Code:

---

Sub Demo()
Application.ScreenUpdating = False
Dim wdApp As New Word.Application, wdDoc As Word.Document
Dim r As Long, i As Long, lRow As Long, lCol As Long
Dim StrFldr As String, StrTmplt As String, StrRcd As String
StrFldr = ActiveWorkbook.Path & "\"
StrTmplt = "Template.dotx"
With ActiveSheet.UsedRange
  lRow = .SpecialCells(xlLastCell).Row
  lCol = .SpecialCells(xlLastCell).Column
  For r = 2 To lRow
    If StrRcd <> .Range("A" & r).Value Then
      StrRcd = .Range("A" & r).Value
      For i = r To lRow
        If .Range("A" & i).Value <> "" Then
          If .Range("A" & i).Value <> StrRcd Then
            i = i - 1
            Exit For
          End If
        End If
      Next
      If i > lRow Then i = lRow
      Set wdDoc = wdApp.Documents.Add(Template:=StrFldr & StrTmplt, AddToRecentFiles:=False, Visible:=False)
      .Range("A" & r & ":" & .Cells(i, lCol).Address).Copy
      With wdDoc
        .Characters.Last.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False
        .SaveAs2 Filename:=StrFldr & StrRcd & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
        .Close False
      End With
      r = i
    End If
  Next
End With
Application.CutCopyMode = False
wdApp.Quit
Application.ScreenUpdating = True
End Sub

---

Note: You'll need to supply the Word template's name. As coded, the macro assumes your document template is stored in the same folder as the workbook.

Thanks for this Paul, I VERY much appreciate all the help.

Your code worked perfectly!

Best,
Rex