@bautto

Veja se o código abaixo resolve:

'Imprime Lista do Mercado

Dim BlocPrint As Range
Dim FirstRow As Integer
Dim LastRow As Integer
Dim LastCol As Integer
  
    Sheets("NovoMerc").Select
  
    Cells(1, 1).Select
  
    LastCol = ActiveSheet.Cells(4, 1).End(xlToRight).Column
    FirstRow = Selection.Row
    LastRow = Cells(Rows.Count, LastCol).End(xlUp).Row
  
    Set BlocPrint = Range(Cells(FirstRow, 1), Cells(LastRow, LastCol))
      
    BlocPrint.Select
  
    With ActiveSheet.PageSetup
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
    With BlocPrint

        Selection.PrintOut Copies:=1, Collate:=True
        Range("A1").Select
    End With

End Sub

@teleguiado, boa tarde.

Fiz a alteração que você sugeriu, mas não funcionou.

Tentei várias alterações nas configurações de impressão e também não adiantou.

Inclusive colocando os comandos de impressão dentro do "with" de sua sugestão.

Vou continuar experimentando...

Agradeço sua ajuda.

Sub ImprimeLista()

'Imprime Lista do Mercado

Dim BlocPrint As Range
Dim FirstRow As Integer
Dim LastRow As Integer
Dim LastCol As Integer
  
    Sheets("Compras").Select
  
    Cells(1, 1).Select
  
    LastCol = ActiveSheet.Cells(4, 1).End(xlToRight).Column
    FirstRow = Selection.Row
    LastRow = Cells(Rows.Count, LastCol).End(xlUp).Row
  
    Set BlocPrint = Range(Cells(FirstRow, 1), Cells(LastRow, LastCol))

    With ActiveSheet.PageSetup
        BlocPrint.Select
        .FitToPagesWide = 1
        .FitToPagesTall = 1
        Selection.PrintOut Copies:=1, Collate:=True
        Range("A1").Select
    End With
    
   End Sub

@bautto

Tente assim:

Sub ImprimeLista()

'Imprime Lista do Mercado

Dim BlocPrint As Range
Dim FirstRow As Integer
Dim LastRow As Integer
Dim LastCol As Integer
  
    Sheets("Compras").Select
  
    Cells(1, 1).Select
  
    LastCol = ActiveSheet.Cells(4, 1).End(xlToRight).Column
    FirstRow = Selection.Row
    LastRow = Cells(Rows.Count, LastCol).End(xlUp).Row
  
    Set BlocPrint = Range(Cells(FirstRow, 1), Cells(LastRow, LastCol))

    With ActiveSheet.PageSetup
        BlocPrint.Select
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
        Selection.PrintOut Copies:=1, Collate:=True
        Range("A1").Select
    End With
    
   End Sub

@teleguiado, boa tarde.

Agradeço sua nova sugestão.

Resolveu quanto a imprimir em uma única página, mas ficou muito reduzido, pois enquadrou toda a área de impressão em apenas uma coluna ainda.

A intenção é dividir essa área em duas colunas, para não precisar usar a redução por zoom.

Estou pensando em incluir uma fórmula para contar as linhas a serem impressas, dividir de forma que cada coluna não tenha mais que 60 linhas, incluindo o cabeçalho e aí, imprimir cada segmento de 60 linhas em colunas diferentes, mas estou com dificuldade nessa tarefa.

Agradeço seu interesse.

Abçs.