View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Tom Ogilvy Tom Ogilvy is offline
external usenet poster
 
Posts: 27,285
Default 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