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

 

[scampie]

Ive just tried it on a new workbook where I have pasted just the values to test and not the formulas, it works there but not on the workbook with formulas. The "YES" is created using a formula also. Sorry, I'm completely new to VBA x

 

[VBE313]

VBA doesn't read formulas like that, it reads the cell value, I just tried putting formulas for "YES" and it worked... Please keep in mind VBA is case sensitive, if it is "YES" then the code needs to be switched

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" Or 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]

I have managed to get it to half work! I found some data way down the rows which I have now deleted. When I run the macro it is populating the sheet but if i run it again it is linking to cells further down in the sheet it is copying from. Hopefully u can see what i mean in the formula bar

 

[scampie]

And ideally I want it to pastespecial values only not the formulas. so I can clear the ebay output sheet, add new data and then add that onto the output sheet.

 

[VBE313]

Change

.Rows(cl.Row).Copy Destination:=Sheets("Output sheet").Range("A" & lastRow)

to whatever column you want to find the last row in. I used A as the example. Whatever column that will always receive data, change it to that column letter instead of the “A” & lastRow.

If this doesn’t work with the data you are grabbing, then we will have to come up with another solution.

 

[VBE313]

I am not by a computer only using my iPad so I can‘t test this code but I’m pretty sure this paste values will work...

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" Or cl.Value = "YES" Then
            With Sheets("Output sheet")
                lastRow = .Cells(.Rows.Count, "AD").End(xlUp).Row + 1
            End With
            .Rows(cl.Row).Copy
            With Sheets(“Output sheet”)
                  .Range(“A” & lastRow).PasteSpecial xlPasteValues
            End With
        Application.CutCopyMode = False
        End If
    Next cl
End With
End Sub

 

[scampie]

That is looking spot on! The only problem was it didn't like your quotation marks on your iPad which I quickly spotted! Thank you so much for your help x

 

[scampie]

Can I be cheeky and ask for help changing 1 thing? Instead of looking for yes in column AD, id like it to copy any columns which have a value in A. Ignoring formulas. I added the yes when trying to work it out myself so its actually a bit of a wasteful work around which isnt needed, I just didnt know how do it if a cell contains any value x

 

[VBE313]

Sub TestEbay()
Dim cl As Object, strCells As String, lastRow As Long
With Sheets("Ebay output")
    strCells = "A2:A" & .Cells(.Rows.Count, "A").End(xlUp).Row
    For Each cl In .Range(strCells)
        If cl.Value <> "" Then
            With Sheets("Output sheet")
                lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
            End With
            .Rows(cl.Row).Copy
            With Sheets("Output sheet")
                  .Range("A" & lastRow).PasteSpecial xlPasteValues
            End With
        Application.CutCopyMode = False
        End If
    Next cl
End With
End Sub