Macro que permita generar archivo único en PDF

A los integrantes de este foro, en esta ocasión recurro a uds, para que brinde su apoyo con esta macro y lo que básicamente es generar archivos PDF en forma individual de una lista de nombres como se aprecia en las imágenes

Imagen nro 1: lista de nombres

Imagen nro 2: archivos PDF

Y lo que requiero es que si pudiera hacer en 1 solo archivos pdf, todos los nombres, desde ya agradezco su apoyo y colaboración.

Option Explicit
Sub ElegirAccion()
Dim i As Integer
Dim intInicial As Integer
Dim intFinal As Integer
Dim intConsecutivo As Integer
Dim srtTitulo As String
Dim Ruta As String
Dim nombre As String
Dim pass As String, hoja As String

Application.ScreenUpdating = False
Sheets("BOLETA PDF").Activate
hoja = "BOLETA PDF"
pass = "A"
ActiveSheet.Unprotect pass

nombre = ThisWorkbook.Sheets("BOLETA PDF").Range("O4").Value

srtTitulo = "PRUEBITA"
intConsecutivo = ThisWorkbook.Sheets("BOLETA PDF").Range("CONSECUTIVO").Value

intInicial = Sheets("BOLETA PDF").Range("N4")
intFinal = Sheets("BOLETA PDF").Range("M3")
If intFinal < intInicial Or intFinal > intConsecutivo Then
MsgBox "Valida el ID final.", vbExclamation, srtTitulo
Else
Sheets("BOLETA PDF").Select
Ruta = ActiveWorkbook.Path & "\BOLETAS"
For i = intInicial To intFinal
ThisWorkbook.Sheets("BOLETA PDF").Range("L4").Value = i

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Ruta & "\" & Sheets("BOLETA PDF").Range("B6") & " " & "BOLETAS MN " & Sheets("BOLETA PDF").Range("H7") & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Next i
End If
ActiveSheet.Protect pass
Sheets("MENU").Activate
Range("B8").Select
intInicial = Sheets("BOLETA PDF").Range("N4")
Application.ScreenUpdating = True
End Sub

Añade tu respuesta

Haz clic para o