Paste to next empty row with VBA

[scampie]

I am trying to copy certain rows from one sheet to another which is working perfectly, but I need it to paste the data to the next empty row. Any help would be greatly appreciated.

Sub TestEbay()

Dim Cell As Range

With Sheets("Ebay output")
    ' loop column H untill last cell with value (not entire column)
    For Each Cell In .Range("ad2:ad" & .Cells(.Rows.Count, "ad").End(xlUp).Row)
        If Cell.Value = "YES" Then
             ' Copy>>Paste in 1-line (no need to use Select)
            .Rows(Cell.Row).Copy Destination:=Sheets("Output sheet").Rows(Cell.Row)
        End If
    Next Cell
End With

End Sub

 

[VBE313]

Do you want all rows or just certain rows? Here is all rows...

Sub TestEbay()
Dim cl As Object, strCells As String, lastRow As Long
With Sheets("Output sheet")
    lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With
With Sheets("Ebay output")
    strCells = "AD2:AD" & .Cells(.Rows.Count, "AD").End(xlUp).Row
    For Each cl In .Range(strCells)
        If cl.Value = "Yes" Then
            .Rows(cl.Row).Copy Destination:=Sheets("Output sheet").Range("A" & lastRow)
        End If
    Next cl
End With
End Sub

 

[scampie]

I want to copy and paste all rows which have "YES" in the AD column. I have tried your code and it hasn't pasted anything.

 

[VBE313]

Sorry try this...

Sub TestEbay()
Dim cl As Object, strCells As String, lastRow As Long
With Sheets("Ebay output")
    strCells = "AD2:AD" & .Cells(.Rows.Count, "AD").End(xlUp).Row
    For Each cl In .Range(strCells)
        If cl.Value = "Yes" Then
            With Sheets("Output sheet")
                lastRow = .Cells(.Rows.Count, "AD").End(xlUp).Row + 1
            End With
            .Rows(cl.Row).Copy Destination:=Sheets("Output sheet").Range("A" & lastRow)
        End If
    Next cl
End With
End Sub

 

[scampie]

Do you have your sheet called "Output sheet"? Did you get any errors? It worked fine for me....

Yes, the code i added originally works, it just does not paste to the next empty row. No errors, just nothingness.

 

[VBE313]

Yes, the code i added originally works, it just does not paste to the next empty row. No errors, just nothingness.

Please try the code above. I changed the text.

Sub TestEbay()
Dim cl As Object, strCells As String, lastRow As Long
With Sheets("Ebay output")
    strCells = "AD2:AD" & .Cells(.Rows.Count, "AD").End(xlUp).Row
    For Each cl In .Range(strCells)
        If cl.Value = "Yes" Then
            With Sheets("Output sheet")
                lastRow = .Cells(.Rows.Count, "AD").End(xlUp).Row + 1
            End With
            .Rows(cl.Row).Copy Destination:=Sheets("Output sheet").Range("A" & lastRow)
        End If
    Next cl
End With
End Sub

 

[scampie]

Still nothing Im afraid

 

[VBE313]

Please take a screenshot of your "Output sheet"

 

[scampie]

 

[VBE313]

Please take a screenshot of the "Ebay output"... My code works for me