Copy-Paste A Filtered Excel Table into Word

[Rex MaGuire]

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.



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

23010

[macropod]

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.

[Rex MaGuire]

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

[macropod]

Try:

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.

[Rex MaGuire]

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

Your code worked perfectly!

Best,
Rex