Hi

I'm struggling with the following problem.
I have an excel sheet that exists of two columns, name and e-mail.
Now, I have to print the entire sheet, but it is about 2500 rows long.

Is there a possibility to let excel print it twice per page?

So, for example:

Instead of printing the following (consider it to be a long list):

Jack Higgins
Peter Jackson
....
....
-- here would be the end of the first printed page
Mike Wilson
Joe Placido k.placido
....
....
-- here would be the end of te second printed page

Excel should be able to print it in the following way:

Jack Higgins Mike Wilson

Peter Jackson Joe Placido

..... ....
..... ....
..... ....


I'm a little familiar with programming in excel, but not so much in
implementing
it (with vb, for example). If you use such a method, please also
explain
how to implement it.

Thanks a lot in advance
pygmalion

Jack Higgins Mike Wilson

Peter Jackson Joe Placido

.... ....
.... ....
....

For the record, the e-mail address of the right cells should be on the
same line, after the name.

Try this.

It takes a while on 2500 rows.

Sub compressrows()
Dim s As String
Dim linesperpage As Long ' how many lines per page
Dim rss As Long ' source row start
Dim rse As Long ' source row end
Dim r As Long ' row counter
Dim wsn As Worksheet ' new worksheet
Dim skip As Boolean ' flag for skipping none moving data

On Error GoTo error_line
s = InputBox("", "How many lines per page?", 60)
If s = "" Then Exit Sub ' catch cancel
linesperpage = CLng(s) ' convert to long
Application.ScreenUpdating = False
ActiveSheet.Copy , ActiveSheet ' copy sheet
Set wsn = ActiveSheet
' get first and last rows
rss = wsn.UsedRange.Row ' start row
rse = rss + wsn.UsedRange.rows.Count - 1 'end row
' get lines per page manual way.....
skip = True
For r = rss To rse Step linesperpage
If skip = False Then 'move alternate block
With wsn.Range(Cells(r, 1), Cells(r + linesperpage - 1, 2))
.Copy wsn.Cells(r - linesperpage, 3)
.Clear
End With
End If
skip = Not skip
Next r
'delete rows
For r = rse To rss Step -1
If wsn.Cells(r, 1) = "" Then
wsn.rows(r).Delete
End If
Next r
error_line:
Application.ScreenUpdating = True
End Sub--
Hope this helps
Martin Fishlock
Please do not forget to rate this reply.


"pygmalion" wrote:


Jack Higgins Mike Wilson

Peter Jackson Joe Placido

.... ....
.... ....
....

For the record, the e-mail address of the right cells should be on the
same line, after the name.