Macro combina excel con word y envía correo en pdf

Creé una macro ( copia de una creada por ti Dante ) que trabaja con planilla Excel y word

Básicamente en una planilla Excel dígito el código del trabajador,

A través de funciones de Excel me trae todos los datos del trabajador de otra hoja de la misma planilla Excel Ahora viene las macros : presiono un botón con macro

" Genera ( ) ", cuya función es combinar correspondencia word

Con los datos de Excel ( Me genera un certificado del trabajador cuyo código ingresé en la planilla Excel, el nombre del archivo toma el código del trabajador ) . Hasta aquí todo bien, pero cuando trato de hacerlo de nuevo, pongo el código de otro trabajador que llamaré trabajador 2, me graba el archivo con el código del trabajador 2, pero los datos del documentos son los del trabajador 1.

La otra parte de las instrucciones me resulta bien, lo que hace es enviar por correo el archivo, esto lo hace a través de macro " envía "

Sub generarut()
'Por.Dante Amor
Dim w As Object
Set w = CreateObject ("Word.application")
Set documento = w.Documents.Open_ 
("d:\certificados\certificado_antiguedad.docx")
w.Visible = True 
patharch = "d:\certificados\_
certificado_antiguedad.docx"
For i = 2 To Range("A" & Rows.Count)._
End(xlUp).Row 
Set ObjWord = CreateObject("Word.Application") 
        ObjWord.Visible = True
        ObjWord.Documents.Add Template:=patharch,_ 
NewTemplate:=False, DocumentType:=0        '
 For j = 1 To Cells(1, Columns.Count)_
.End(xlToLeft).Column 
 textobuscar = Cells(1, j)
 ObjWord.Selection.Move 6, -1 
 ObjWord.Selection._
Find.Execute FindText:=textobuscar
            '
    While ObjWord.Selection.Find.found = True 
       ObjWord.Selection.Text = Cells(i, j) 
          ObjWord.Selection.Move 6, -1
           ObjWord.Selection._
Find.Execute FindText:=textobuscar
            Wend
        Next
   'guarda como word
   'convierte a pdf
       ruta = "d:\certificados\"
       nombd = ruta & Cells(i, "A") & ".docx"
        nombp = ruta & Cells(i, "A") & ".pdf"
      ObjWord.ActiveDocument.SaveAs nombd   
       pdf = ObjWord.ActiveDocument.
_ExportAsFixedFormat( _
       nombp, 17, False, 0, 0, , , 0, False, True, 1)
       ObjWord.Quit (False)
    Next
    w.Documents.Close SaveChanges_
:=wdDoNotSaveChanges 
   w.Quit 
   End Sub
Sub envia()
'
    Dim OutApp As Object
    Dim OutMail As Object
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    j = 2
    numCorreo = ThisWorkbook.Worksheets("base")_
.Range("T" & j)
    Do While numCorreo <> ""
            Call EnviaCorreo(Range("T" & j).Value,_ 
 Range("W1").Value, Range("W3").Value,_
(Range("w2").Value &_
 "" & Range("A" & j).Value & ".pdf"))
     j = j + 1
     numCorreo = ThisWorkbook.Worksheets("base")._
Range("T" & j)
    Loop
End Sub