Código para crear botón que guarde e imprima dos recibos de pago diferentes en una hoja.

Te anexo la macro completa

Private Sub TODO_EN_UNO_Recibo_Obreros_Fijos_Click()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Set h2 = Sheets("Carga")
    Set h3 = Sheets("Recibo Obreros Fijos ")
    Set h4 = Sheets("Formato")
    '
    fila = 18
    ruta = "C:\Documents and Settings\Administrador\Escritorio\Recibos de Pago\Obreros Fijos\"
    'ruta = ThisWorkbook.Path & "\"
    Do While h2.Cells(fila, "B") <> ""
        h4.Rows.Hidden = False
        h4.Range("A:I").Clear
        h4.DrawingObjects.Delete
        h3.[F5] = h2.Cells(fila, "A")
        'Aqui guarda recibo1 a PDF
        APdf h3
        'copia recibo 1
        h3.Range("A7:I" & h3.Range("C" & Rows.Count).End(xlUp).Row).Copy
        h4.Range("A" & 1).PasteSpecial Paste:=xlValues
        h4.Range("A" & 1).PasteSpecial Paste:=xlFormats
        h4.Range("A" & 2).PasteSpecial Paste:=xlPasteColumnWidths
        CopiarImagen2 h3, h4, 3
        '
        If h2.Cells(fila + 1, "B") <> "" Then
            h3.[F5] = h2.Cells(fila + 1, "A")
            'Aqui guarda recibo2 a PDF
            aPdf h3
            'copia recibo 2
            h3.Range("A7:I" & h3.Range("C" & Rows.Count).End(xlUp).Row).Copy
            u3 = h4.Range("C" & Rows.Count).End(xlUp).Row + 2
            h4.Range("A" & u3).PasteSpecial Paste:=xlValues
            h4.Range("A" & u3).PasteSpecial Paste:=xlFormats
            CopiarImagen2 h3, h4, u3 + 2
        End If
        '
        u4 = h4.Range("C" & Rows.Count).End(xlUp).Row
        For i = 15 To u4
            If h4.Cells(i, "H") = 1 And h4.Cells(i, "I") = 1 Then
                h4.Rows(i).Hidden = True
            End If
        Next
        'Aqui imprime
        With h4.PageSetup
            .PrintArea = "A1:G" & h4.Range("C" & Rows.Count).End(xlUp).Row
            .Orientation = xlPortrait
            .FitToPagesWide = 1
            .FitToPagesTall = 1
            .LeftMargin = Application.InchesToPoints(0.590551181102362)
            .RightMargin = Application.InchesToPoints(0.590551181102362)
            .TopMargin = Application.InchesToPoints(0.393700787401575)
            .BottomMargin = Application.InchesToPoints(0.393700787401575)
            .HeaderMargin = Application.InchesToPoints(0)
            .FooterMargin = Application.InchesToPoints(0)
        End With
        h4.PrintOut Copies:=1, Collate:=True
        '
        fila = fila + 2
    Loop
    MsgBox "Impresión realizada y el Respaldo del recibo fue generado con exito", vbInformation, "IMPRIMIR RECIBO"
End Sub
Sub CopiarImagen2(h3, h4, u3)
'Por.Dante Amor
    h3.Shapes("Imagen 1").Copy
    h4.Select
    h4.Paste
    Selection.Top = h4.Range("B" & u3).Top
    Selection.Left = h4.Range("B" & u3).Left + 20
    h3.Shapes("Imagen 2").Copy
    h4.Paste
    Selection.Top = h4.Range("G" & u3).Top
    Selection.Left = h4.Range("G" & u3).Left + 5
End Sub
Sub aPdf(h3)
'Por.Dante Amor
    h3.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=ruta & h3.Range("C17") & ".pdf", _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, From:=2, to:=2, OpenAfterPublish:=False
End Sub

Saludos.Dante Amor

Recuerda valorar la respuesta.