Sub Excel_To_Word()
Application.ScreenUpdating = False
Dim h1 As Worksheet, wPath As String, wTemplate As String, wText As String
Dim objWord As Object
'
Set h1 = Sheets("[COLOR=#ff0000]Sheet5[/COLOR]")
wPath = "[COLOR=#ff0000]C:\trabajo\books\[/COLOR]"
wTemplate = "[COLOR=#ff0000]MyTemplate.dotx[/COLOR]"
wText = "[COLOR=#ff0000]Here_Paste_Range[/COLOR]"
'
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
objWord.Documents.Add template:=wPath & wTemplate, NewTemplate:=False, DocumentType:=0
'
h1.Range("[COLOR=#ff0000]A1:D10[/COLOR]").Copy
objWord.Selection.Move 6, -1 'moverse al principio del documento
objWord.Selection.Find.Execute FindText:=wText
If objWord.Selection.Find.found = True Then
objWord.Selection.PasteExcelTable False, True, False
End If
objWord.Activate
objWord.ActiveDocument.SaveAs wPath & "[COLOR=#ff0000]NewWord[/COLOR]"
objWord.ActiveDocument.Close
objWord.Quit
'
Application.CutCopyMode = False
End Sub