I am using the macro below to copy the contents of a spreadsheet and then automatically
produce a Word document with a filename determined by :-
StrFileName = "X:\Quotes\WordEducationalQuotes\" & Replace(Sheets("CopySheet").Range("B2"), " ", "") & ".doc"
What I would like to do is first open a word template (x:\Quotes\MasterQuoteTemplate.doc), then past the contents into the template, then save it with a filename determined by :- StrFileName = "X:\Quotes\WordEducationalQuotes\" & Replace(Sheets("CopySheet").Range("B2"), " ", "") & ".doc"
Could someone help me with the coding to achieve this please.
Many Thanks Ed
Sub Copy2Word()
Dim appWD As Word.Application
Dim StrFileName As String
StrFileName = "X:\Quotes\WordEducationalQuotes\" & Replace(Sheets("CopySheet").Range("B2"), " ", "") & ".doc"
Set appWD = CreateObject("Word.Application")
appWD.Visible = True
appWD.Documents.Add
Sheets("CopySheet").Range("B2:G48").Copy
appWD.Selection.PasteExcelTable False, False, True
With appWD.Selection.ParagraphFormat
.LeftIndent = appWD.CentimetersToPoints(-2.54)
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
End With
appWD.Selection.PageSetup.LeftMargin = CentimetersToPoints(0.95)
appWD.ActiveDocument.SaveAs Filename:=StrFileName, FileFormat:= _
wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:= _
True, WritePassword:="", ReadOnlyRecommended:=False
End Sub
produce a Word document with a filename determined by :-
StrFileName = "X:\Quotes\WordEducationalQuotes\" & Replace(Sheets("CopySheet").Range("B2"), " ", "") & ".doc"
What I would like to do is first open a word template (x:\Quotes\MasterQuoteTemplate.doc), then past the contents into the template, then save it with a filename determined by :- StrFileName = "X:\Quotes\WordEducationalQuotes\" & Replace(Sheets("CopySheet").Range("B2"), " ", "") & ".doc"
Could someone help me with the coding to achieve this please.
Many Thanks Ed
Sub Copy2Word()
Dim appWD As Word.Application
Dim StrFileName As String
StrFileName = "X:\Quotes\WordEducationalQuotes\" & Replace(Sheets("CopySheet").Range("B2"), " ", "") & ".doc"
Set appWD = CreateObject("Word.Application")
appWD.Visible = True
appWD.Documents.Add
Sheets("CopySheet").Range("B2:G48").Copy
appWD.Selection.PasteExcelTable False, False, True
With appWD.Selection.ParagraphFormat
.LeftIndent = appWD.CentimetersToPoints(-2.54)
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
End With
appWD.Selection.PageSetup.LeftMargin = CentimetersToPoints(0.95)
appWD.ActiveDocument.SaveAs Filename:=StrFileName, FileFormat:= _
wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:= _
True, WritePassword:="", ReadOnlyRecommended:=False
End Sub