Moving a row from one sheet to another and deleting it from the first shee

[MOHAMEDADEN]

Hello all,


I want to start off by apologizing for posting a question that has been answered a DOZEN time, however, I've been tasked with this at work and cannot seem to get the codes to work!

What I'm looking to do:
Sheet 1 name - 30 and 50 day reviews
Sheet 2 name - 30 and 50 day completed reviews

• I have a header in sheet 1, but essentially anything in the column "P" that says "completed" - that row should be moved to sheet 2, which is the EXACT same template. ​
  <strike></strike>
• I'm trying to make sure it deletes the row from sheet 1.

Thanks sooooo much in advance.

 

[footoo]

Do you want the "completed" rows on Sheet1 moved to the same row numbers on Sheet2 ?

 

[MOHAMEDADEN]

Yes please! so every time an item is completed and marked in the P column in sheet 1 - it would delete and move to sheet 2 in the same order

 

[My Aswer Is This]

Try this:
This is an auto sheet event script
Your Workbook must be Macro enabled
To install this code:
Right-click on the sheet tab named: 30 and 50 day reviews
Select View Code from the pop-up context menu
Paste the code in the VBA edit window

Private Sub Worksheet_Change(ByVal Target As Range)
'Modified  10/2/2018  10:13:46 PM  EDT
If Not Intersect(Target, Range("P:P")) Is Nothing Then
Dim r As Long
If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub
    If Target.Value = "completed" Then
        Dim Lastrow As Long
        Lastrow = Sheets("30 and 50 day completed reviews").Cells(Rows.Count, "P").End(xlUp).Row + 1
        r = Target.Row
        Rows(r).Copy Sheets("30 and 50 day completed reviews").Rows(Lastrow)
        Rows(r).Delete
    End If
End If
End Sub

 

[JoeMo]

You didn't provide much information on the data layout. I'm assuming headers on both sheets start in A1 and run at least to P1 so the data are captured when using the current region around P1.

Sub MoveCompleted()
Const Status As String = "=*completed*"
Dim Sht1 As Worksheet, Sht2 As Worksheet, Tgt As Range
Set Sht1 = Sheets("30 and 50 day reviews")
Set Tgt = Sht1.Range("P1").CurrentRegion
Set Sht2 = Sheets("30 and 50 day completed reviews")
Application.ScreenUpdating = False
With Tgt
    .AutoFilter Field:=16, Criteria1:=Status, Operator:=xlAnd
    On Error Resume Next
    With Tgt.Offset(1, 0).Resize(Tgt.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
        .Copy Destination:=Sht2.Cells(Rows.Count, "A").End(xlUp).Offset(1)
        .EntireRow.Delete
    End With
    On Error GoTo 0
    .AutoFilter
End With
Application.ScreenUpdating = True
End Sub

 

[My Aswer Is This]

My script copies the row into the first empty row in the copy to sheet.
If you really want it copied into the exact same row it was in on the copy from sheet. That would be difficult because your saying you want that row deleted after copying over.
This will cause rows on copy from sheet to shift up.

Private Sub Worksheet_Change(ByVal Target As Range)
'Modified  10/2/2018  10:13:46 PM  EDT
If Not Intersect(Target, Range("P:P")) Is Nothing Then
Dim r As Long
If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub
    If Target.Value = "completed" Then
        Dim Lastrow As Long
        Lastrow = Sheets("30 and 50 day completed reviews").Cells(Rows.Count, "P").End(xlUp).Row + 1
        r = Target.Row
        Rows(r).Copy Sheets("30 and 50 day completed reviews").Rows(Lastrow)
        Rows(r).Delete
    End If
End If
End Sub

 

[footoo]

Yes please! so every time an item is completed and marked in the P column in sheet 1 - it would delete and move to sheet 2 in the same order

In the order each row is completed or in the Sheet1 row order?

 

[MOHAMEDADEN]

You didn't provide much information on the data layout. I'm assuming headers on both sheets start in A1 and run at least to P1 so the data are captured when using the current region around P1.

Sub MoveCompleted()
Const Status As String = "=*completed*"
Dim Sht1 As Worksheet, Sht2 As Worksheet, Tgt As Range
Set Sht1 = Sheets("30 and 50 day reviews")
Set Tgt = Sht1.Range("P1").CurrentRegion
Set Sht2 = Sheets("30 and 50 day completed reviews")
Application.ScreenUpdating = False
With Tgt
    .AutoFilter Field:=16, Criteria1:=Status, Operator:=xlAnd
    On Error Resume Next
    With Tgt.Offset(1, 0).Resize(Tgt.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
        .Copy Destination:=Sht2.Cells(Rows.Count, "A").End(xlUp).Offset(1)
        .EntireRow.Delete
    End With
    On Error GoTo 0
    .AutoFilter
End With
Application.ScreenUpdating = True
End Sub

This worked AMAZINGLY! THANK YOU 100 TIMES

 

[JoeMo]

This worked AMAZINGLY! THANK YOU 100 TIMES

You are welcome - thanks for the reply.