Move data from one sheet to another with if criteria

sharky12345

Well-known Member
Joined
Aug 5, 2010
Messages
3,354
Office Version
  1. 2016
Platform
  1. Windows
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?
 

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
11,962
Office Version
  1. 2013
  2. 2010
Platform
  1. Windows
Try this macro.
Code:
 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:
Code:
Sheets("Sheet1").Range("A" & rng.Row & ":X" & rng.Row).ClearContents
to this line
Code:
Sheets("Sheet1").Rows(rng.Row).EntireRow.Delete
 
Last edited:

sharky12345

Well-known Member
Joined
Aug 5, 2010
Messages
3,354
Office Version
  1. 2016
Platform
  1. Windows
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

Well-known Member
Joined
Aug 5, 2010
Messages
3,354
Office Version
  1. 2016
Platform
  1. Windows
Problem solved - I turned automatic calculation off before running your code then back on again - that has solved it.

Many thanks!
 

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
11,962
Office Version
  1. 2013
  2. 2010
Platform
  1. Windows
My pleasure. :)
 

Forum statistics

Threads
1,171,686
Messages
5,876,892
Members
433,217
Latest member
Muhammad Tanzeel Ur Rehma

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top