VBA

[Genetu]

Hello guys? is there any VBA code to print a selected range (A1:J25") two times on a single piece of paper?

 

[Joe4]

If it were me, I would probably open a new workbook, copy over my range to that new workbook twice, print it, and then close the workbook without saving it.

You can probably get most of the VBA code you need for that by turning on the Macro Recorder and record yourself performing those steps manually.
If you do that and need a little help modifying or cleaning-up the recorded code afterwards, post your recorded code here along with a description of what you need changed.

 

[Logit]

Option Explicit

Sub PrintRng()
Dim numrow As Long
Dim i As Long
Dim runmacro
    runmacro = Application.InputBox("How many print copies?", "Enter a number", , , , , , 1)
    
    If IsNumeric(numrow) Then
        For i = 1 To runmacro
            Range("A1:J25").PrintOut
        Next i
    End If
End Sub

 

[Genetu]

I will do that, and return tomorrow after recording the macro. Thank you, Joe.

 

[Joe4]

Option Explicit

Sub PrintRng()
Dim numrow As Long
Dim i As Long
Dim runmacro
    runmacro = Application.InputBox("How many print copies?", "Enter a number", , , , , , 1)
   
    If IsNumeric(numrow) Then
        For i = 1 To runmacro
            Range("A1:J25").PrintOut
        Next i
    End If
End Sub

Logit,

Look at the requirements again.
They are not looking to print two separate sheets of paper.
They want the same range print twice on a single sheet of paper.

 

[Logit]

The following first creates a TEMP sheet to paste to ... then it copies the specified range and pastes it twice to the TEMP sheet. The TEMP sheet is
printed and then deleted.

As indicated in the code, you may be able to utilize a larger font depending upon your printer. In order to get all of the data onto a single sheet
on my printer I had to select the FONT indicated.

Option Explicit

Sub copypaste()

    Dim ScreenUpdating As Boolean
    Dim PasteSht As Worksheet
    Dim Rg As Range
    Dim Txt As String
    Dim i As Integer
    
    On Error Resume Next

    Sheets.Add.Name = "Temp"

    Txt = ActiveWindow.RangeSelection.Address
    Set Rg = Sheets("Sheet1").Range("A1:J25") '<-- change range to copy here
    
    If Rg Is Nothing Then Exit Sub
    Set PasteSht = Worksheets("Temp")
    
    Application.ScreenUpdating = False
    
    Rg.Copy
    
    For i = 1 To 2
        PasteSht.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    Next
    
    
    Application.CutCopyMode = False
    
    Worksheets("Temp").Activate
    Range("A1").Select
    ActiveSheet.Cells.Font.Name = "Calibri"
    ActiveSheet.Cells.Font.Size = 6         '<--- You may be able to use a larger font depending on your printer
    
    With Worksheets("Temp")
        .PageSetup.Orientation = xlLandscape
        .PageSetup.PrintArea = "$A$1:$J$51"
        .FitToPagesWide = 1
        .FitToPagesTall = 1
        .PageSetup.PrintArea = .UsedRange.Address
        .PrintOut
    End With
    
    Application.ScreenUpdating = True

    Application.DisplayAlerts = False
    Sheets("Temp").Delete
    Application.DisplayAlerts = True

End Sub