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

On Fri, 23 Oct 2009 07:39:01 -0700, Bill
wrote:

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

Thanks worked great

"Gord Dibben" wrote:

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

On Fri, 23 Oct 2009 07:39:01 -0700, Bill
wrote:

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

.

Good to hear.

Thanks for the feedback.


Gord

On Fri, 23 Oct 2009 11:20:06 -0700, Bill
wrote:

Thanks worked great

"Gord Dibben" wrote:

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

On Fri, 23 Oct 2009 07:39:01 -0700, Bill
wrote:

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

.