Exportar a un sólo PDF que depende de una ficha de empleado

Envíame el archivo a mi correo

Mi correo [email protected]

En el asunto del correo escribe tu nombre de usuario “Daniel Roz” y el título de esta pregunta.

Hola, buenos días. Ya te he enviado el correo. Un saludo, gracias.

Te anexo la macro actualizada

Sub imprime()
'Por.Dante Amor
    Pregunta = MsgBox("Se van a imprimir TODOS los empleados. ¿ESTÁS SEGURO?", _
        vbQuestion + vbYesNo, "¡¡ OJO !!. Importante")
    If Pregunta = 7 Then End
    '
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set h1 = Sheets("Planificación anual")
    Set h2 = Sheets("Calendario")
    '
    Set h3 = Sheets.Add
    '
    With h3.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.669291338582677)
        .RightMargin = Application.InchesToPoints(0.47244094488189)
        .TopMargin = Application.InchesToPoints(0.275590551181102)
        .BottomMargin = Application.InchesToPoints(0.354330708661417)
        .HeaderMargin = Application.InchesToPoints(0.15748031496063)
        .FooterMargin = Application.InchesToPoints(0.15748031496063)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    '
    For n = 7 To h2.Range("BG3")
        h2.Range("E6") = h1.Range("F" & n)
        h2.PrintOut Copies:=1, Collate:=True
        u = h3.UsedRange.Rows(h3.UsedRange.Rows.Count).Row + 1
        If u = 2 Then u = 1
        Set rango = Range("A1:AD40")
        h2.Range(rango.Address).Copy
        h3.Cells(u, "A").PasteSpecial Paste:=xlPasteValues
        h3.Cells(u, "A").PasteSpecial Paste:=xlPasteFormats
        h3.Cells(u, "A").PasteSpecial Paste:=xlPasteColumnWidths
        For i = 1 To rango.Rows.Count
            alto = h2.Rows(i).Height
            h3.Rows(i).RowHeight = alto
        Next
        u = h3.UsedRange.Rows(h3.UsedRange.Rows.Count).Row + 1
        h3.HPageBreaks.Add Before:=h3.Cells(u, "A")
    Next
    '
    ruta = ThisWorkbook.Path & "\"
    h3.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=ruta & "empleados.pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    h3.Delete
    MsgBox "Archivo empleados.pdf, creado", vbInformation
End Sub

S a l u d o s . D a n t e   A m o r

Recuerda valorar la respuesta.

Hola, buenos días. Está casi perfecto, la única pega es que la primera persona sale perfecta y a partir de la segunda no mantiene el alto de las filas. Te adjunto dos imágenes para que lo veas. Gracias.