EXPORTAR RANGO DE DATOS A PLANTILLA DE WORD

[esunpez]

Buen día a todos.  Tengo 2 bases de datos, una "Base de Producción" llevo el registro de los pedidos solicitados. Mediante +BUSCARV busca el código en una hoja con los datos generales de los códigos.  Una vez que se concluye el trabajo, copio y pego el archivo "Cuentas x Cobrar" asignando una hoja a cada proyecto y renombrando la hoja de acuerdo al consecutivo del proyecto "tru-329-2021, tru-330-2021, etc. para después copiarlo y mandar a un archivo de word que es mi plantilla de presupuesto para ser enviado al cliente.

Esta última parte es la que estoy tratando de mejorar... investigué y generé parte del código para que las celdas seleccionadas se copien y peguen en la "Plantilla" de word  y así evitar el copiar y pegar. Sin embargo me sale un error de ejecución que no he podido corregir.

Ojala puedan ayudarme a saber que se necesita corregir. 

 

Saludos

Fernando

EJEMPLOS.zip

[esunpez]

después de un rato de buscar en internet con varias referencias y modificar mi código he podido mandar la tabla a la plantilla de word. Talvez sin el formato ajustado pero lo envía. Lo que no he podido generar es que busque el código del presupuesto (tru-xxx-2021) y lo cambie por el nombre de la hoja de excel.  Seguiré buscando mientras alguien pude darme una idea de como hacerlo.   Aquí el código corregido.

 

Sub tablaaword()

patharch = ThisWorkbook.Path & "\PlantillaOK.docx"
Dim WordApp As Object
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = True
WordApp.Documents.Add Template:=patharch, NewTemplate:=False, DocumentType:=0
Selection.Copy

textobuscar = "[tabla_excel]"

WordApp.Selection.Move 6, -1 'moverse al principio del documento
WordApp.Selection.Find.Execute FindText:=textobuscar

While WordApp.Selection.Find.Found = True 'reemplaza el texto, y busca si hay otro para reemplazarlo
WordApp.Selection.PasteSpecial link:=True

WordApp.Selection.Move 6, -1
WordApp.Selection.Find.Execute FindText:=textobuscar
Wend

WordApp.Activate

End Sub