Guru do Excel e Power BI

O código ainda não está terminado, pois a ideia é fazer um loop ao longo das informações preenchidas na tabela e criar um arquivo word para cada nome. Entretanto, já vislumbro o problema, uma vez que quando tento rodar o código novamente o erro 462 é apontado. Alguma luz? Agradeço desde já...Segue o código:

Private Sub btn_montar_contrato_Click()

Dim WdApp As Word.Application
Dim wdDOC As Word.Document
Dim rng As Word.Range
Set wdDOC = Nothing


On Error Resume Next
Set WdApp = GetObject(, "Word.Application")
If Err.Number > 0 Then
Set WdApp = CreateObject("Word.Application")
On Error GoTo 0
End If

WdApp.DisplayAlerts = False
WdApp.Visible = True

Set wdDOC = Word.Documents.Open("C:\Users\paulo\Desktop\teste\modelo_recisao.docx")


With wdDOC
'*Dados locador
.Application.Selection.HomeKey Unit:=wdStory
.Application.Selection.Find.ClearFormatting
.Application.Selection.Find.Forward = True
.Application.Selection.Find.Text = "#nome"
.Application.Selection.Find.Execute , , , , , , , , , Plan3.Range("d3"), wdReplaceAll


.Application.Selection.HomeKey Unit:=wdStory
.Application.Selection.Find.ClearFormatting
.Application.Selection.Find.Forward = True
.Application.Selection.Find.Text = "#datainic"
.Application.Selection.Find.Execute , , , , , , , , , Plan3.Range("h3"), wdReplaceAll

.Application.Selection.HomeKey Unit:=wdStory
.Application.Selection.Find.ClearFormatting
.Application.Selection.Find.Forward = True
.Application.Selection.Find.Text = "#datarec"
.Application.Selection.Find.Execute , , , , , , , , , Plan3.Range("k3"), wdReplaceAll

.Application.Selection.HomeKey Unit:=wdStory
.Application.Selection.Find.ClearFormatting
.Application.Selection.Find.Forward = True
.Application.Selection.Find.Text = "#horario"
.Application.Selection.Find.Execute , , , , , , , , , Plan3.Range("l3"), wdReplaceAll

.Application.Selection.HomeKey Unit:=wdStory
.Application.Selection.Find.ClearFormatting
.Application.Selection.Find.Forward = True
.Application.Selection.Find.Text = "#nivel"
.Application.Selection.Find.Execute , , , , , , , , , Plan3.Range("m3"), wdReplaceAll

.Application.Selection.HomeKey Unit:=wdStory
.Application.Selection.Find.ClearFormatting
.Application.Selection.Find.Forward = True
.Application.Selection.Find.Text = "#faculdade"
.Application.Selection.Find.Execute , , , , , , , , , Plan3.Range("n3"), wdReplaceAll

.Application.Selection.HomeKey Unit:=wdStory
.Application.Selection.Find.ClearFormatting
.Application.Selection.Find.Forward = True
.Application.Selection.Find.Text = "#datafim"
.Application.Selection.Find.Execute , , , , , , , , , Plan3.Range("k3"), wdReplaceAll

.Application.Selection.HomeKey Unit:=wdStory
.Application.Selection.Find.ClearFormatting
.Application.Selection.Find.Forward = True
.Application.Selection.Find.Text = "#unidade"
.Application.Selection.Find.Execute , , , , , , , , , Plan3.Range("c3"), wdReplaceAll

.Application.Selection.HomeKey Unit:=wdStory
.Application.Selection.Find.ClearFormatting
.Application.Selection.Find.Forward = True
.Application.Selection.Find.Text = "#curso"
.Application.Selection.Find.Execute , , , , , , , , , Plan3.Range("q3"), wdReplaceAll

.Application.Selection.HomeKey Unit:=wdStory
.Application.Selection.Find.ClearFormatting
.Application.Selection.Find.Forward = True
.Application.Selection.Find.Text = "#horas"
.Application.Selection.Find.Execute , , , , , , , , , Plan3.Range("t3"), wdReplaceAll

.Application.Selection.HomeKey Unit:=wdStory
.Application.Selection.Find.ClearFormatting
.Application.Selection.Find.Forward = True
.Application.Selection.Find.Text = "#hext"
.Application.Selection.Find.Execute , , , , , , , , , Plan3.Range("z3"), wdReplaceAll

.Application.Selection.HomeKey Unit:=wdStory
.Application.Selection.Find.ClearFormatting
.Application.Selection.Find.Forward = True '
.Application.Selection.Find.Text = "#datarec"
.Application.Selection.Find.Execute , , , , , , , , , Plan3.Range("w3"), wdReplaceAll

.Application.Selection.HomeKey Unit:=wdStory
.Application.Selection.Find.ClearFormatting
.Application.Selection.Find.Forward = True
.Application.Selection.Find.Text = "#supervisor"
.Application.Selection.Find.Execute , , , , , , , , , Plan3.Range("v3"), wdReplaceAll

wdDOC.SaveAs ("C:\Users\paulo\Desktop\teste\" & Range("d3").Value & "_RECISAO.docx")
wdDOC.Close

End With
wdDOC.DisplayAlerts = True
WdApp.Quit acQuitSaveNone
Set wdDOC = Nothing
Set WdApp = Nothing


End Sub

Bom dia!!

Eu creio que você deve ter copiado uma parte dessa rotina em algum lugar, veja se ajuda.
http://stackoverflow.com/questions/3363 ... navailable

Leia:
https://anictteacher.files.wordpress.co ... solved.pdf

Att

Obrigado pela resposta. Realmente fui fazendo adaptações . Li o material, mas não percebi onde posso esta errando. obrigado pelo retorno.
Consegui fazer o loop sem problemas, mas quando tento rodar novamente aparece o erro como previsto

Bom dia!!

Eu sinto muito mas eu não testei seu código, creio que possa ser alguma declaração que está conflitando, eu recomendo usar o depurador e debugar seu código!


Att