Printing 2 sets of coulmns on one page

  • Thread starter Thread starter Bill
  • Start date Start date
B

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
 
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
 
Thanks worked great

Gord Dibben said:
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



.
Click to expand...
 
Back
Top