extract with criteria
 

Dim rw as Long, rng as Range
Dim cell as Range
rw = 2
With activeSheet
set rng = intersect(.columns(4),.usedrange).cells
End with
for each cell in rng
if application.Sum(rng.Resize(1,5)) 0 then
cell.EntireRow.Copy Destination:=worksheets(2).Cells(rw,1)
rw = rw + 1
end if
Next

--
Regards,
Tom Ogilvy

"Samambaia" wrote in message
...
I need to copy several lines from 'sheet 1' to sheet 2' that from column D
to H that the sum(D:H) is greater than zero.

I know this can be done thru filters but the users of this spreadsheet
have very limited Excel knowledge (less than I have :), so I am trying to do
it thru VBA.

Thanks in advance.

Samambaia

extract with criteria
 

Thank you so much !!!