Exportar de Excel fichas de horarios en un solo PDF

Te anexo la macro para generar un archivo pdf con todos los empleados.

Sub imprime()
'Act.Por.Dante Amor
    Dim Pregunta As Integer
    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
    ruta = ThisWorkbook.Path
    '
    For n = 7 To h2.Range("BG3")
        h1.Range("D" & n).Copy h2.Range("E6")
        h2.PrintOut Copies:=1, Collate:=True
        u = h3.UsedRange.Rows(h3.UsedRange.Rows.Count).Row + 1
        h2.Range("A1:G47").Copy h3.Cells(u, "A")
    Next
    '
    h3.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:="empleados.pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    h3.Delete
    MsgBox "Archivo empleados.pdf, creado", vbInformation
End Sub

En esta parte de la macro,

H2. Range("A1:G47")

Tienes que cambiar "A1:G47", por el rango de celdas de la hoja "Calendario" que quieras enviar al Pdf, ese mismo rango será enviado al pdf cada vez que cambie el empleado.

El nombre del archivo pdf será: "empleados.pdf"

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

Recuerda valorar la respuesta.

Muchas gracias, me está sirviendo de mucha ayuda. Pero tengo una última duda:

En la parte de la macro donde pega en una nueva hoja necesito que lo pegue como valores, eso sí, manteniendo el formato, porque si no me salen errores de las fórmulas.

u = h3.UsedRange.Rows(h3.UsedRange.Rows.Count).Row + 1
        h2.Range("A1:AD40").Copy h3.Cells(u, "A")

Te anexo la macro actualizada

Sub imprime()
'Act.Por.Dante Amor
    Dim Pregunta As Integer
    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
    ruta = ThisWorkbook.Path & "\"
    '
    For n = 7 To h2.Range("BG3")
        h1.Range("D" & n).Copy h2.Range("E6")
        h2.PrintOut Copies:=1, Collate:=True
        u = h3.UsedRange.Rows(h3.UsedRange.Rows.Count).Row + 1
        h2.Range("A1:G47").Copy
        h3.Cells(u, "A").PasteSpecial Paste:=xlPasteValues
        h3.Cells(u, "A").PasteSpecial Paste:=xlPasteFormats
    Next
    '
    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.

Está perfecto, pero ahora me ha surgido otro problema :-( , necesito que conserve el ancho de filas y columnas. Para las columnas lo veo fácil poniendo el ancho de columna de la hoja nueva que crea, pero para las filas no se como hacerlo, porque se van repitiendo y necesitaria crear unas 150 secuencias. Te digo un ejemplo: la fila 1 debe ir a un ancho 3, la 2 a 32,25, la 3 a 11,25, la 4 a 24,......, pero como copia las fichas una detrás de otra, esta secuencia debería repetise a partir de la fila 41, 82,....

Espero haberme explicado, mil gracias

Perdón...

También necesito que el PDF sea en horizontal y que cada pegado de la hoja calendario vaya en una hoja independiente del PDF, de tal manera que cuando impriman el PDF salga cada ficha en una hoja.

Te anexo la macro actualizada

Sub imprime()
'Act.Por.Dante Amor
    Dim Pregunta As Integer
    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
    h3.PageSetup.Orientation = xlLandscape
    ruta = ThisWorkbook.Path & "\"
    '
    For n = 7 To h2.Range("BG3")
        h1.Range("D" & n).Copy h2.Range("E6")
        h2.PrintOut Copies:=1, Collate:=True
        u = h3.UsedRange.Rows(h3.UsedRange.Rows.Count).Row + 1
        If u = 2 Then u = 1
        h2.Rows("1:40").Copy h3.Cells(u, "A")
        h2.Range("A1:AD40").Copy
        h3.Cells(u, "A").PasteSpecial Paste:=xlPasteValues
        h3.Cells(u, "A").PasteSpecial Paste:=xlPasteFormats
        h3.Cells(u, "A").PasteSpecial Paste:=xlPasteColumnWidths
        u = h3.UsedRange.Rows(h3.UsedRange.Rows.Count).Row + 1
        h3.HPageBreaks.Add Before:=h3.Cells(u, "A")
    Next
    '
    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

Recuerda valorar la respuesta.

Perdona que sea tan pesado, pero me da un error y es porque al copiar y haber celdas combinadas me da el siguiente error: