Excel - Macro que permita generar archivo único en PDF

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

ExportAsFixedFormat Type:=xlTypePDF, Filename:=Ruta & "\" & Sheets("BOLETA PDF").Range("B6") & " " & "BOLETAS MN " & Sheets("BOLETA PDF").Range("H7") & ".pdf", _

ExportAsFixedFormat Type:=xlTypePDF, Filename:=Ruta & "\" & Sheets("BOLETA PDF").Range("B6") & " " & "BOLETAS MN " & Sheets("BOLETA PDF").Range("H7") & "_" &  format(time,"HHMMSS") &".pdf", _