cut & paste row

[kenpcli]

Hi All,

I need a script to look down cell "D" and if it is empty then cut that row and paste at the bottom of the sheet.

Thanks

 

[JazzSP8]

Try this

Sub MoveToBottom()
Application.ScreenUpdating = False
LastRow = Range("A" & Rows.Count).End(xlUp).Row

For x = LastRow To 1 Step -1
    If Cells(x, "D").Value = "" Then
        Rows(x).EntireRow.Copy Destination:=Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        Rows(x).Delete
    End If
Next x

Application.ScreenUpdating = True

End Sub

You might need to amend the sheet name and the column counter to one that hits the actual bottom of your data.

 

[kenpcli]

Thanks that worked great.