how to print table in two columns?

Question

I have a table with more lines that fit on an A4 page, but if divided into two can be printed on one page, with two columns. I’ve checked other sites and got help, but it hasn’t. I attach the code I used in my attempt. If you can help me, I really appreciate it.

`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 = 2
        Selection.PrintOut Copies:=1, Collate:=True
        Range("A1").Select
    End With

End Sub

Answer 1

Hi!

I did a slight gambit, but I believe it brings the desired result.

As it is not possible to adjust the print configuration to print two columns, my idea was to create an auxiliary tab in which the shopping list is copied and printed as desired.

Follows the code:

Sub ImprimeLista()

'Imprime Lista do Mercado

Dim BlocPrint As Range
Dim FirstRow As Integer
Dim LastRow As Integer
Dim LastCol As Integer
Dim W       As Worksheet
Dim WB      As Worksheet

Application.DisplayAlerts = False

    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
  
       
    'Adiciona uma nova aba e copia a tabela para ela
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = "Impressão"
    Set WB = Sheets("Impressão")
    Set W = Sheets("Compras")
    
    W.Select
    
    'Seleciona a primeira metade
    Set BlocPrint = W.Range(Cells(FirstRow, 1), Cells((LastRow / 2), LastCol))
    BlocPrint.Select
    Selection.Copy
    WB.Select
    WB.Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False
    Application.CutCopyMode = False
        
    'Seleciona a segunda metade
    W.Select
    Set BlocPrint = W.Range(Cells((LastRow / 2), 1), Cells((LastRow), LastCol))
    BlocPrint.Select
    
    Selection.Copy
    WB.Select
    WB.Range("G4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False
    Application.CutCopyMode = False
    
    'Coloca um cabeçalho na segunda coluna
    WB.Range("A1:E3").Select
    Selection.Copy
    WB.Range("G1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("A1:E1").Select
    
    'Ajeita as colunas com produtos
    WB.Range("A:A").EntireColumn.AutoFit
    WB.Range("G:G").EntireColumn.AutoFit
    WB.Columns(6).ColumnWidth = 2
   
   
  'Configura a impressão
   With ActiveSheet.PageSetup
        WB.Select
        WB.Range("A:G").Select
'        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = False
        Selection.PrintOut Copies:=1, Collate:=True
        Range("A1").Select
    End With
    
    'Seleciona a planilha Compras e exclui a planilha Impressão
    W.Select
    W.Range("A1").Select
    WB.Delete

Application.DisplayAlerts = True

End Sub

The end result was this: https://www.sendspace.com/file/6psv97

I hope you solve.