Printout Code Problem

[Jonsson]

Hi,

How to modify the code down below, to prinout the numbers at one sheet

Not as now on several sheets, as the conditions are tested down to ro
206.

Sub HideRows()
Dim i As Long
For i = 5 To 206
Rows(i).EntireRow.Hidden = Range("BQ" & i).Value = 0
Next i
Range("A1").Select
ActiveSheet.PrintOut
End Su

 

[Tom Ogilvy]

If you mean a specific sheet:
Sub HideRows()
Dim i As Long
With worksheets("Sheet1")
For i = 5 To 206
.Rows(i).EntireRow.Hidden = _
.Range("BQ" & i).Value = 0
Next i
.PrintOut
End With
End Sub

if you mean make the 206 dynamic

Sub HideRows()
Dim i As Long, lastRow as long
lastRow = cells(rows.count,"A").end(xlup).row
For i = 5 To lastRow
Rows(i).EntireRow.Hidden = Range("BQ" & i).Value = 0
Next i
Range("A1").Select
ActiveSheet.PrintOut
End Sub

Change the "A" to indicate the column to test to find the last row

 

[Jonsson]

Hi Tom,

Your code did´nt solve my problem.

This is what I want to do:

Instead of printing all of the pages from the sheet,(9 pages), I wan
to "compress" the rows to be print outed on one page, as I have hidde
the unwanted rows.

Sorry for my bad english!!
Hope you can understand me anyway!!

//Thoma

 

[Tom Ogilvy]

Sub PrintRows()
Dim i As Long, rw as Long
Dim sh as Worksheet
Dim sh1 as Worksheet
Dim wkbk as Workbook
set wkbk = Activeworkbook
workbooks.Add
set sh1 = ActiveSheet
rw = 1
for each sh in wkbk.worksheets
For i = 5 To 206
if sh.Range("BQ" & i).Value <> 0 then
sh.Rows(i).EntireRow.copy Destination:=sh1.Cells(rw,1)
rw = rw + 1
End if
Next i
Next sh
Sh1.PrintOut
sh1.parent.close Savechanges:=False
End Sub

 

[Jonsson]

Hi Tom,

I ran into new problems when using your new code.
As I have lookup functions and several others of links and formulas, i
wont work to use a new workbook.

See attached file example, and you will understand what I mean.

I´m really grateful for your struggle to help me!!

//Thoma

 

[Tom Ogilvy]

Sub PrintRows()
Dim i As Long, rw as Long
Dim sh as Worksheet
Dim sh1 as Worksheet
Dim wkbk as Workbook
set wkbk = Activeworkbook
workbooks.Add
set sh1 = ActiveSheet
rw = 1
for each sh in wkbk.worksheets
For i = 5 To 206
if sh.Range("BQ" & i).Value <> 0 then
sh.Rows(i).EntireRow.copy
sh1.Cells(rw,1).PasteSpecial xlvalues
sh1.Cells(rw,1).PasteSpecial xlFormats
rw = rw + 1
End if
Next i
Next sh
Sh1.PrintOut
sh1.parent.close Savechanges:=False
End Sub

 

[Jonsson]

Hi Tom,

Is the only way to solve this problem using a new wbk?
I´d really appreciate if you could come up with a solution that
work in the mainwbk.

Thanks in advance!!

//Thoma

 

[Tom Ogilvy]

You can add a sheet to the existing workbook instead, but then you would
have to exclude your code from trying to copy from that sheet.

 

[Jonsson]

Hi Tom,

As I have a timeformat that is controlled from a VBA-code in the mai
sheet, and that code will be missing in the new sheet I get the wron
format and only zeros.

Thanks for all your help, I really apprecciate it, but I´ll have t
think of another solution.

//Thomas

P.S

I have found it!

If I choose Archive-Printarea and select my wanted area, then I get al
values on the same sheet!!

Many thanks!!

//Thoma