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

--
Regards,
Tom Ogilvy


"Jonsson " wrote in message
...
Hi Tom,

I ran into new problems when using your new code.
As I have lookup functions and several others of links and formulas, it
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!!

//Thomas


---
Message posted from http://www.ExcelForum.com/