Move data from one sheet to another with if criteria

[sharky12345]

I have data on Sheet1 in rows A:X, (row 1 is a Header).

I want a macro that will check for any row where the value in column W is nothing, (empty cell), and if that applies move the data in that row from columns A:V only, to the next empty row on Sheet2, before deleting the data in A:X on Sheet1.

Anyone?

 

[mumps]

Try this macro.

 Sub CopyData()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Sheets("Sheet1").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim rng As Range
    For Each rng In Sheets("Sheet1").Range("W2:W" & LastRow)
        If rng = "" Then
            Sheets("Sheet1").Range("A" & rng.Row & ":V" & rng.Row).Copy Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
            Sheets("Sheet1").Range("A" & rng.Row & ":X" & rng.Row).ClearContents
        End If
    Next rng
    Application.ScreenUpdating = True
End Sub

This will clear the cells in columns A to X. It will leave an empty row. If you want to delete the entire row, then change this line:

Sheets("Sheet1").Range("A" & rng.Row & ":X" & rng.Row).ClearContents

to this line

Sheets("Sheet1").Rows(rng.Row).EntireRow.Delete

 

[sharky12345]

Thanks! - there is a slight issue though, if I run the code I get the hourglass for ages and the only way to exit is to press escape. Any ideas?

 

[sharky12345]

Problem solved - I turned automatic calculation off before running your code then back on again - that has solved it.

Many thanks!

 

[mumps]

My pleasure.