Selecting cells from a list greater than zero and pasting to another sheet

What I am trying to do is a little advanced for me and I need help. I am trying to find all the cells in a list that have a value greater than zero and copy them, then paste them in order onto another sheet. Right now I have a code than only finds a specific value, but not values greater than zero. Here is an attachment that finds only a specific value and only highlights the cell, not copy and paste it.

Thank you


Test File.xlsm

Hi pasqualebaldi,
try it

Sub ertert()
Dim r As Range
With Sheets("Sheet1")
    With .Range("A1", .Cells(Rows.count, 1).End(xlUp))
        Set r = .Find(0, lookat:=xlWhole)
        If Not r Is Nothing Then
            .ColumnDifferences(r).Copy Sheets("Sheet2").Range("A1")
        End If
    End With
End With
End Sub

Thank you! I thought I would be able to tweak the code a little to add a few cells to copy in addition, but I'm not familiar enough with this code. I've attach another file with what exactly I am trying to accomplish. I appreciate your time.

Thank you


Test File2.xlsm

please try again

Private Sub Button2_Click()
Dim r As Range
With Sheets("Sheet1").Range("B14").CurrentRegion
    Set r = .Columns(3).Find(0, lookat:=xlWhole)
    If Not r Is Nothing Then
        Intersect(.Cells, .Columns(3).ColumnDifferences(r).EntireRow).Copy Sheets("Sheet2").Range("A1")
    End If
End With
End Sub

Originally Posted by nilem

please try again

Private Sub Button2_Click()
Dim r As Range
With Sheets("Sheet1").Range("B14").CurrentRegion
    Set r = .Columns(3).Find(0, lookat:=xlWhole)
    If Not r Is Nothing Then
        Intersect(.Cells, .Columns(3).ColumnDifferences(r).EntireRow).Copy Sheets("Sheet2").Range("A1")
    End If
End With
End Sub

Nilem, that worked great thank you! Out of curiosity, is it possible to look up the price value greater than zero, like it currently is doing, and then only paste the item name on "sheet 2" and not the item price or item #?

Thank you

Private Sub Button2_Click()
Dim r As Range
With Sheets("Sheet1").Range("B14").CurrentRegion
    Set r = .Columns(3).Find(0, lookat:=xlWhole)
    If Not r Is Nothing Then
        Intersect(.Columns(1), .Columns(3).ColumnDifferences(r).EntireRow).Copy Sheets("Sheet2").Range("A1")
    End If
End With
End Sub

Originally Posted by nilem

Private Sub Button2_Click()
Dim r As Range
With Sheets("Sheet1").Range("B14").CurrentRegion
    Set r = .Columns(3).Find(0, lookat:=xlWhole)
    If Not r Is Nothing Then
        Intersect(.Columns(1), .Columns(3).ColumnDifferences(r).EntireRow).Copy Sheets("Sheet2").Range("A1")
    End If
End With
End Sub

Nilem,
I hope you had a good weekend. I'm sorry to bring up this up again, but I am trying to use this code on another sheet and I am having trouble. In the file I have attached, this code works great taking information from Sheet2 and putting it onto Sheet3. I tried to use this code to take information from Sheet1 and also put it on Sheet3, but I can not get the code to do anything. If you could help, I appreciate your time.

Thank you

New Test File.xlsm