Buenas tardes, tengo esta macro que encontré en SanGoogle y la adapté a mi proyecto el cual funciona al 100% lo unico que al imprimir en A4 este lo hace en vertical y necesitaria que esta lo haga en horizontal, gracias por adelantado si alguno de los maestros me adaptaria dicha macro.

 

Private Sub CommandButton5_Click()

Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next

'Elimina hoja y crea hoja dando el mismo nombre que la eliminada

Sheets("DFSHJFDUYDAYRAIUY544TTTOMYDUTGD").Delete
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.name = "DFSHJFDUYDAYRAIUY544TTTOMYDUTGD"
Set A = Sheets("DFSHJFDUYDAYRAIUY544TTTOMYDUTGD")

MsgBox "Esta seguro de imprimir los datos"

For i = 0 To LISTA.ListCount - 1
    A.Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1) = LISTA.List(i, 0)
    A.Range("B" & Range("B" & Rows.Count).End(xlUp).Row + 1) = LISTA.List(i, 2)
    A.Range("C" & Range("C" & Rows.Count).End(xlUp).Row + 1) = LISTA.List(i, 3)
    A.Range("D" & Range("D" & Rows.Count).End(xlUp).Row + 1) = LISTA.List(i, 4)
    A.Range("E" & Range("E" & Rows.Count).End(xlUp).Row + 1) = LISTA.List(i, 5)
    A.Range("F" & Range("F" & Rows.Count).End(xlUp).Row + 1) = LISTA.List(i, 6)
    A.Range("G" & Range("G" & Rows.Count).End(xlUp).Row + 1) = LISTA.List(i, 7)
    A.Range("H" & Range("H" & Rows.Count).End(xlUp).Row + 1) = LISTA.List(i, 11)
    A.Range("I" & Range("I" & Rows.Count).End(xlUp).Row + 1) = LISTA.List(i, 12)
    A.Range("J" & Range("J" & Rows.Count).End(xlUp).Row + 1) = LISTA.List(i, 14)
    
Next

A.Range("A1") = "PRUEBA DE IMPRESIÓN"

With A.Range("A1:J1")
.Merge
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
.RowHeight = 20
.Font.Size = 16
End With

A.Range("A2") = "AAAAAAAA"        'escribimos el encabezado de la columna
A.Range("B2") = "BBBBBBBB"
A.Range("C2") = "CCCCCCCC"
A.Range("D2") = "DDDDDDDD"
A.Range("E2") = "EEEEEEEE"
A.Range("F2") = "FFFFFFFF"
A.Range("G2") = "GGGGGGGG"
A.Range("H2") = "HHHHHHHH"
A.Range("I2") = "IIIIIIIIIII"
A.Range("J2") = "JJJJJJJJ"

uf = A.Range("K" & Rows.Count).End(xlUp).Row
A.Range("B2:K" & uf).NumberFormat = "#.#,0"
A.Range("I2:I" & uf).NumberFormat = "dd/mm/yyyy"
A.Range("A:K").Columns.AutoFit
A.Range("A:A").ColumnWidth = 10
Application.PrintCommunication = True
With ActiveSheet.PageSetup
.PrintArea = "$A$1:$J$" & uf + 4
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
Application.PrintCommunication = True
ActiveSheet.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
A.Delete
Sheets("Hoja10").Select
MsgBox "El informe se imprimió con éxito", vbCritical, "AVISO"
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

 

With ActiveSheet.PageSetup

.Orientation = xlLandscape

.PrintArea = "$A$1:$J$" & uf + 4
.FitToPagesWide = 1
.FitToPagesTall = 1
End With

Antoni, perfecto y muchas gracias por la rapidez