Fucionar macros de creacion y registro de PDF

Quisiera ver si puede ayudar en ajustar unas macros, les explico, tengo una macro que crea en excel certicados en pdf, luego registra en una hoja aparte dentro de libro los datos: 1 Nombre del participantes, 2 nombre y ubicacion del archivo en el HD, asi posteriormente lo envio por correo (con otra macro), desde el mismo excel, hasta aca todo bien.
Mi problema es que lo hago 1 por 1, aca esta una macro que probe muy buena de creacion de pdf por lotes, lo que busco, si es posible, incluir que cada archivo que cree registre su informacion en una hoja y continue el ciclo, y como se ve en la pirmera macro, seleccionar el rango a guardar.
Gracias de Antemano
Macro 1 Creacion y registro 1x1
Sub Crear_PDF()
Sheets("Certificados").Select
'Nombre para el archivo
nombre = Range("K64").Value
'Rango inicio y final selecionado
Range("A1:K66").Select
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\PDFcertificados\" & nombre, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
'Celda final selecionada
Range("A9").Select
'Registro creacion del PDF
Sheets("Envio").Select
Range("B160:D160").Select
Selection.Copy
Range("B3").Select
    Do While ActiveCell <> Empty
    ActiveCell.Offset(1, 0).Select
    Loop
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveCell.Offset(1, 0).Range("B3").Select
    Application.CutCopyMode = False
    Range("B3").Select
    Sheets("Certificados").Select
'Celda final selecionada
Range("A9").Select
End Sub
Macro 2 Creacion PDF por lotes, usa como valor un rango indicado en celdas, esta no hace registro
Sub Crearlotes()
' Crear lotes de certificados pdf
inicio = Range("M16").Value
fin = Range("N16").Value
For i = inicio To fin
             Range("M11").FormulaR1C1 = i
archivo = Range("D119") & "\" & Range("D107") & ".pdf"
             ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=archivo
Next
Range("M11") = ""
End Sub

Añade tu respuesta

Haz clic para o