Automatically move cells from one sheet to another based on criteria using VBA

[JCarney0899]

This code currently deletes the entire row based on criteria set in cell K from Sheet 1(Roster) to Sheet 2(Lead) but I need this code to copy rows A through G in Sheet 1(Roster) to Sheet 2(Lead) if cell K shows the criteria of "Interested". I am new to VBA & found this code (& it worked just not exactly what I need it to work for) in a forum.

Sub MoveBasedOnValue()
Dim xRg As Range
Dim xCell As Range
Dim A As Long
Dim B As Long
Dim C As Long
Dim D As Long
Dim E As Long
Dim F As Long
Dim G As Long
A = Worksheets("Roster").UsedRange.Rows.Count
B = Worksheets("Lead").UsedRange.Rows.Count
If B = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Lead").UsedRange) = 0 Then B = 0
End If
Set xRg = Worksheets("Roster").Range("K3:K" & A)
On Error Resume Next
Application.ScreenUpdating = False
For C = 1 To xRg.Count
If CStr(xRg(C).Value) = "Interested" Then
xRg(C).EntireRow.Copy Destination:=Worksheets("Lead").Range("A" & B + 1)
xRg(C).EntireRow.Delete
If CStr(xRg(C).Value) = "Interested" Then
C = C - 1
End If
B = B + 1
End If
Next
Application.ScreenUpdating = True
End Sub


This is the worksheet code

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim xRg As Range
Dim xCell As Range
Dim A As Long
Dim B As Long
Dim C As Long
Dim D As Long
Dim E As Long
Dim F As Long
Dim G As Long
A = Worksheets("Roster").UsedRange.Rows.Count
B = Worksheets("Lead").UsedRange.Rows.Count
If B = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Lead").UsedRange) = 0 Then B = 0
End If
Set xRg = Worksheets("Roster").Range("K3:K" & A)
On Error Resume Next
Application.ScreenUpdating = False
For C = 1 To xRg.Count
If CStr(xRg(C).Value) = "Interested" Then
xRg(C).EntireRow.Copy Destination:=Worksheets("Lead").Range("A" & B + 1)
xRg(C).EntireRow.Delete
C = C - 1
End If
Next
Application.ScreenUpdating = True
End Sub

 

[DanteAmor]

Welcome to the MrExcel forum. Please accept my warmest greetings and sincere hope that all is well.

but I need this code to copy rows A through G in Sheet 1(Roster) to Sheet 2(Lead) if cell K shows the criteria of "Interested".

For that, try the following:

Sub Copy_BasedOnValue()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim lr1 As Long, lr2 As Long
  
  Set sh1 = Sheets("Roster")
  Set sh2 = Sheets("Lead")
 
  lr1 = sh1.Range("K" & Rows.Count).End(3).Row
  lr2 = sh2.UsedRange.Rows.Count
  If Application.WorksheetFunction.CountA(sh2.UsedRange) = 0 Then lr2 = 0
 
  If WorksheetFunction.CountIf(sh1.Range("K3:K" & lr1), "Interested") > 0 Then
    sh1.Range("A2:K" & lr1).AutoFilter 11, "Interested"
    sh1.AutoFilter.Range.Range("A2:G" & lr1).Copy sh2.Range("A" & lr2 + 1)
    sh1.ShowAllData
  End If
End Sub

----- --
Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
----- --

 

[JCarney0899]

Welcome to the MrExcel forum. Please accept my warmest greetings and sincere hope that all is well.



For that, try the following:

Sub Copy_BasedOnValue()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim lr1 As Long, lr2 As Long
 
  Set sh1 = Sheets("Roster")
  Set sh2 = Sheets("Lead")
 
  lr1 = sh1.Range("K" & Rows.Count).End(3).Row
  lr2 = sh2.UsedRange.Rows.Count
  If Application.WorksheetFunction.CountA(sh2.UsedRange) = 0 Then lr2 = 0
 
  If WorksheetFunction.CountIf(sh1.Range("K3:K" & lr1), "Interested") > 0 Then
    sh1.Range("A2:K" & lr1).AutoFilter 11, "Interested"
    sh1.AutoFilter.Range.Range("A2:G" & lr1).Copy sh2.Range("A" & lr2 + 1)
    sh1.ShowAllData
  End If
End Sub

----- --
Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
----- --

Thank you but I cannot get this to work. I am very new to this so I am sure I am doing something wrong. I'm just not sure why it's not working...

 

[DanteAmor]

Did you run the macro?
What result did he send you?

You can also put an image of your data from both sheets or put the examples using the XL2BB tool.

Note XL2BB:
For the future, it would help greatly if you could give us the sample data in a form that we can copy to test with, rather that a picture.
MrExcel has a tool called “XL2BB” that lets you post samples of your data that will allow us to copy/paste it to our Excel spreadsheets, so we can work with the same copy of data that you are. Instructions on using this tool can be found here: XL2BB Add-in
Note that there is also a "Test Here” forum on this board. This is a place where you can test using this tool (or any other posting techniques that you want to test) before trying to use those tools in your actual posts.

 

[JCarney0899]

Did you run the macro?
What result did he send you?

You can also put an image of your data from both sheets or put the examples using the XL2BB tool.

Note XL2BB:
For the future, it would help greatly if you could give us the sample data in a form that we can copy to test with, rather that a picture.
MrExcel has a tool called “XL2BB” that lets you post samples of your data that will allow us to copy/paste it to our Excel spreadsheets, so we can work with the same copy of data that you are. Instructions on using this tool can be found here: XL2BB Add-in
Note that there is also a "Test Here” forum on this board. This is a place where you can test using this tool (or any other posting techniques that you want to test) before trying to use those tools in your actual posts.

It did work! I just didn't realize you had to run the macro. Do you have to do that every time you make a change to the spreadsheet, or can it run automatically?

 

[DanteAmor]

I recommend that you run it when you want to copy the cells. Otherwise, it will be running all the time and will worsen the performance of your sheet.

And it will duplicate the records, that is, if there are 5 records that are copied and you modify the sheet again, those same 5 records will be copied again.

So think about when they should be copied?