Moving and Deleting rows from one worksheet to another

[C_Bolton123]

Hi There!
I've seen previous questions on how to move a row from one worksheet to another when marked as "completed", and have copied the code and made it work for me - so thank you!
But now I'd like to delete that row from the first sheet, so it only appears on the second sheet, titled "Completed Projects".
Can anyone help me with this?

Thanks so much!

 

[Saurabhj]

Hi,

Check below code:

If unable to modify as per existing code, please share your previous code.

Sub copyDelete()
Dim source As Worksheet
Dim dest As Worksheet

Set source = Sheets("Sheet1")
Set dest = Sheets("Sheet2")

source.Range("1:1").Copy

dest.Activate
dest.Range("A1").Select
dest.Paste

source.Range("1:1").Delete
End Sub

 

[C_Bolton123]

Sub copyDelete() Dim source As Worksheet Dim dest As Worksheet Set source = Sheets("Sheet1") Set dest = Sheets("Sheet2") source.Range("1:1").Copy dest.Activate dest.Range("A1").Select dest.Paste source.Range("1:1").Delete End Sub

Hi Saurabhj - thank you for your help!
Here's the original code I used :

Private Sub Worksheet_Change(ByVal Target As Range)
'Modified 2/21/2020 9:01:00 AM EST
If Target.Column = 8 Then
If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub
Dim Lastrow As Long
Dim SheetName As String
SheetName = "Completed Projects"
Dim SearchValue As String
SearchValue = "Completed"
If Target.Value = SearchValue Then
Lastrow = Sheets(SheetName).Cells(Rows.Count, 5).End(xlUp).Row + 1
Rows(Target.Row).Copy Sheets(SheetName).Rows(Lastrow)
End If
End If
End Sub

Silly question, If I want to add your code, do I set up as a new code or paste below this one and make updates to the sheet name?
Thank you so much!

 

[Fluff]

How about

Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.CountLarge > 1 Then Exit Sub
   If Not Intersect(Target, Range("H2:H" & Rows.Count)) Is Nothing Then
      If Target.Value = "Completed" Then
         Target.EntireRow.Copy Sheets("Completed Projects").Range("H" & Rows.Count).End(xlUp).Offset(1, -7)
         Target.EntireRow.Delete
      End If
   End If
End Sub

 

[Saurabhj]

Silly question, If I want to add your code, do I set up as a new code or paste below this one and make updates to the sheet name?
Thank you so much!

Hi, you need to add a line in your code.

Private Sub Worksheet_Change(ByVal Target As Range)
'Modified 2/21/2020 9:01:00 AM EST
If Target.Column = 8 Then
       If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub
       Dim Lastrow As Long
       Dim SheetName As String
        SheetName = "Completed Projects"
       Dim SearchValue As String
       SearchValue = "Completed"
       If Target.Value = SearchValue Then
                 Lastrow = Sheets(SheetName).Cells(Rows.Count, 5).End(xlUp).Row + 1
                 Rows(Target.Row).Copy Sheets(SheetName).Rows(Lastrow)
                 Target.EntireRow.Delete                                                                 'Add this line
      End If
End If
End Sub

 

[C_Bolton123]

Hi, you need to add a line in your code.

Private Sub Worksheet_Change(ByVal Target As Range)
'Modified 2/21/2020 9:01:00 AM EST
If Target.Column = 8 Then
       If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub
       Dim Lastrow As Long
       Dim SheetName As String
        SheetName = "Completed Projects"
       Dim SearchValue As String
       SearchValue = "Completed"
       If Target.Value = SearchValue Then
                 Lastrow = Sheets(SheetName).Cells(Rows.Count, 5).End(xlUp).Row + 1
                 Rows(Target.Row).Copy Sheets(SheetName).Rows(Lastrow)
                 Target.EntireRow.Delete                                                                 'Add this line
      End If
End If
End Sub

This is awesome - thank you so much!!

 

[Saurabhj]

Great. Thanks for the feedback.