Printing a certain amount of pages based on amount of data

  • Thread starter Thread starter guerilla
  • Start date Start date
G

guerilla

Hi,

I am using a macro to add data to a worksheet. I want to print the
sheet afterwards, but only enough pages to print all of the data plus
an additional 40 rows or so, for additional written input. How can I
do this?

To take this a stage further, I would like to add a given amount of
pages, the same formatting as those with data but just containing
blank rows. How do I make these full pages as opposed to a page and a
half of formatted workspace and then blank unformatted space?

kind regards,
Matt
 
hi, the following might work but uses some assumptions how your data looks like. First trick is to find the last row. Simple is the use of xlUp but this only works for the column you specify with "A65536".
Since you generate the data with a macro I assume it has a fixed number of columns. In my example the data uses column A to K
good luck
Code:
Sub printarea()
'' by Ronald van Marrewijk Msc.
Dim pages, lastrow, rows_on_page As Integer
lastrow = Range("A65536").End(xlUp).Row  ' assume that column A contains a value
rows_on_page = 40			   'assume you want 40 rowes on a page
pages = Int(lastrow / rows_on_page)  'round the number down
pages = pages + 1 'on extra empty page
ActiveSheet.PageSetup.printarea = "$A$1:$K$" & (pages * rows_on_page) 'assume K is last column
	With ActiveSheet.PageSetup
		.Orientation = xlLandscape
		.PaperSize = xlPaperA4
		.FitToPagesWide = 1
		.FitToPagesTall = pages
	End With
	ActiveWindow.SelectedSheets.PrintPreview
End Sub
 
Sub printsheet()

Const RowsPerPage = 50

LastRow = Cells(Rows.Count, "A").End(xlUp).Row

EmptyRows = LastRow Mod 50
FullPages = Int(LastRow / 50)

Select Case EmptyRows

Case 0
PrintRows = LastRow + RowsPerPage
Case 1 To 40
PrintRows = (FullPages + 2) * RowsPerPage
Case 41 To RowsPerPage
PrintRows = (FullPages + 1) * RowsPerPage
End Select

Cells(LastRow, "A").EntireRow.Copy

Rows((LastRow + 1) & ":" & PrintRows).PasteSpecial _
Paste:=xlPasteFormats

End Sub
 
This uses bottom row borders to add enough lines to create 2 additional page
breaks.
It assumes that the last row in column A is the bottom of the data and
assumes that you want the borders to go from column A to column I. It also
increases row height on the blank rows to a size large enough to write in.
HTH, James

Sub AddLinesToBtm()
Dim myPgs As Long, dRow As Long
Cells(65536, "a").End(xlUp).Select
myPgs = ActiveSheet.HPageBreaks.Count + 2
While ActiveSheet.HPageBreaks.Count < myPgs
ActiveCell.Offset(1).Select
dRow = ActiveCell.Row
Rows(dRow).EntireRow.RowHeight = 20
With Range("A" & dRow & ":I" & dRow).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
Wend
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Back
Top