Moving row to a new sheet using dropdown and also changing data in the new sheet

[TMG738]

Hi,

I have been able to move the specific rows from one sheet to another using a value in a specific cell (using a drop down list).

I have used the following code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("P:P")) Is Nothing Then
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
Application.ScreenUpdating = False
Dim Lastrow As Long
Dim Lastrowa As Long
Lastrow = Sheets("2021").Cells(Rows.Count, "P").End(xlUp).Row + 1
If Target.Value = "Yes" Then
Rows(Target.Row).Copy Destination:=Sheets("2021").Rows(Lastrow)
Application.EnableEvents = False
Rows(Target.Row).Delete
Application.EnableEvents = True
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End If
End Sub

My question are:
1. When the data is cut to the new sheet, can the data in particular cells be removed (i.e left blank) (columns H to O to be blank on the new sheet)
2. Also when the data is cut to the new sheet, can the dates in the cells be updated for example by 1 year? (columns E & F to increase date by one year)

This is my first time posting and not sure how to attach my working file.

Thanks

 

[GWteB]

Hi TMG738, welcome to MrExcel.
Both of your questions can be answered with yes.
Try:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim raDest      As Range
    Dim raCell      As Range

    If Not Intersect(Target, Range("P:P")) Is Nothing Then
        If Target.Cells.Count > 1 Or IsEmpty(Target) Then
            Exit Sub
        Else
            If Target.Value = "Yes" Then
            
                Application.ScreenUpdating = False
                With ThisWorkbook.Sheets("2021")
                    Set raDest = .Cells(.Rows.Count, "P").End(xlUp).Offset(1, 0).EntireRow
                End With
                Me.Rows(Target.Row).Copy Destination:=raDest
                Set raCell = raDest.Cells(1, "E")
                If IsDate(raCell.Value) Then
                    raCell.Value = DateAdd("yyyy", 1, raCell.Value)
                End If
                Set raCell = raDest.Cells(1, "F")
                If IsDate(raCell.Value) Then
                    raCell.Value = DateAdd("yyyy", 1, raCell.Value)
                End If
                raDest.Columns("H:O").ClearContents

                Application.EnableEvents = False
                Me.Rows(Target.Row).Delete
                Application.EnableEvents = True

            End If
            Application.ScreenUpdating = True
        End If
    End If
End Sub

 

[TMG738]

Thank you for your reply and apologies for the delay.

I have tried the code posted, however it does not seem to work. Nothing is happening, even with the old code i have posted?

Is there a way for you to look at this, can I attach a file?

thank you

 

[TMG738]

My apologies, i have now sorted (i forgot to enable macros)

Thank you soo much