Printing 2 sets of coulmns on one page

[Bill]

I have a 2500 entries of three columns. I would like to print 2 sets of the
3 columns on one page (to cut my paper usage in half. Any help is
appreciated.

Thanks
Bill

 

[Gord Dibben]

Sub Set_Two_Times()
Dim iSource As Long
Dim iTarget As Long
Dim cCols As Long
Dim rrows As Long

iSource = 1
iTarget = 1
cCols = 3
rrows = InputBox("rows per set")
Do
Cells(iSource, "A").Resize(rrows, cCols).Cut _
Destination:=Cells(iTarget, "A")
Cells(iSource + rrows, "A").Resize(rrows, cCols).Cut _
Destination:=Cells(iTarget, (cCols + 1))
iSource = iSource + (rrows * 2)
iTarget = iTarget + (rrows)
PageBreak = xlPageBreakManual
Loop Until IsEmpty(Cells(iSource, "A").Value)

End Sub

Tips................enter a number of rows say 56 in inputbox.

This will move rows 57:112 to D1:F56 and shift columns A:C up.

And so on down the sheet.

You will have to adjust pagebreaks depending upon your margin settings.


Gord Dibben MS Excel MVP

 

[Bill]

Thanks worked great

Sub Set_Two_Times()
Dim iSource As Long
Dim iTarget As Long
Dim cCols As Long
Dim rrows As Long

iSource = 1
iTarget = 1
cCols = 3
rrows = InputBox("rows per set")
Do
Cells(iSource, "A").Resize(rrows, cCols).Cut _
Destination:=Cells(iTarget, "A")
Cells(iSource + rrows, "A").Resize(rrows, cCols).Cut _
Destination:=Cells(iTarget, (cCols + 1))
iSource = iSource + (rrows * 2)
iTarget = iTarget + (rrows)
PageBreak = xlPageBreakManual
Loop Until IsEmpty(Cells(iSource, "A").Value)

End Sub

Tips................enter a number of rows say 56 in inputbox.

This will move rows 57:112 to D1:F56 and shift columns A:C up.

And so on down the sheet.

You will have to adjust pagebreaks depending upon your margin settings.


Gord Dibben MS Excel MVP



.

 

[Gord Dibben]

Good to hear.

Thanks for the feedback.


Gord

Thanks worked great