Loop through the column and Copy entire rows where CellValue>0

[OxanaB]

I need to loop through the column and Copy entire rows where CellValue>0
I get only one row.
I will appreciate your help.
Thank you

Sub Macro3()
'
' Macro3 Macro
' Macro recorded 11/16/2004 by default
'
' Keyboard Shortcut: Ctrl+v
Range(ActiveCell, ActiveCell.End(xlDown)).Select
For Each Cell In Selection
If Cell.Value > 0 Then
ActiveCell.EntireRow.Select
Selection.Copy
Rows("8:14").Select
ActiveSheet.Paste
End If
Next Cell
End Sub

 

[Don Guillett]

You are probably copying each over the last paste. Try this.

For Each Cell In Selection
x=cells(rows.count,"a").end(xlup).row+1
If Cell.Value > 0 Then cell.entirerow.copy range("a" & x)
Next Cell

Or, sort & copy the non blanks enmasse