Adjust a row copy macros

Hey Guys,

I have this macro added to the code on the worksheet that does the following:
Basically if on column 21 you type Yes, the whole row is copied on sheet "Extract" on the first available row.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim a As Long
Dim b As Long
If Target.Count > 1 Then Exit Sub
If Len(Target.Value) = 0 Then Exit Sub
a = Target.Row
If IsEmpty(Cells(a, 21)) Then Exit Sub
If Cells(a, 21).Value = "Yes" Then
Rows(a).Copy
b = Sheets("Extract").UsedRange.Rows.Count + 1
Sheets("Extract").Cells(b, 1).PasteSpecial
End If
End Sub

However on Sheet "Extract" it turned out I need to have additional columns. How do I modify the macro to copy the row only up to column 20 (including column 20)?

Thank you!

Do you need to clear Column 21 once the transfer is complete?

Do you also need to clear the row or just act like a copy and paste on the next available row?

If you need the info to stay in you previous sheet (not the Sheets("Extract")) Then delete

Range(Cells(Activecell.row, 1), Cells(Activecell.row, 21)).ClearContents

Hey Excelnoub,

The column is AA. I replaced my macro with yours and updated it like this:

If Not Intersect(Target, Range("AA:AA")) Is Nothing Then 'Change the Y:Y to the column of you column 21
If Target.Cells.Count = 1 Then
If Target.Value = "Yes" Then

Range(Cells(ActiveCell.Row, 1), Cells(Target.Row, 20)).Copy
Sheets("Extract").Cells(ActiveCell.Row, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues

End If
End If
End If

But it doesn't seem to copy anything when I write Yes in AA. Did i update it correctly ?

If Not Intersect(Target, Range("Y:Y")) Is Nothing Then 'Change the Y:Y to the column of you column 21
If Target.Cells.Count = 1 Then
If Target.Value = "Yes" Then

Range(Cells(Activecell.row, 1), Cells(Target.Row, 20)).Copy
Sheets("Extract").Cells(Activecell.row, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Range(Cells(Activecell.row, 1), Cells(Activecell.row, 21)).ClearContents

End If
End If
End If

Let me know if this works for you

Do you press Enter? I would add a Validation list in your Column AA so the when you drop down and select Yes the code will run.

Try clicking in the cell again the code will run...

Add Application.CutCopyMode = False after the last End If

Give me one min I have the same kind of code in one of my workbook and works like a charm...

I will rearange the code to fit what you need.

Thank you Excelnoub.

But keep in mind that this will not clear the content in Cell, row 27 ("AA"), So you will need to add this if you need to clear the cell AA from the "Yes"

Cells(Target.Row, 27).ClearContents

Also...

For Screenupdating:

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Not Intersect(Target, Range("AA:AA")) Is Nothing Then
If Target.Cells.Count = 1 Then
If Target.Value = "Yes" Then
        
    Range(Cells(Target.Row, 1), Cells(Target.Row, 20)).Copy
    Sheets("Extract").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    Cells(Target.Row, 27).ClearContents



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

Sorry for the multiple post I am doing 5 things at once lol

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Range("AA:AA")) Is Nothing Then
    If Target.Cells.Count = 1 Then
    If Target.Value = "Yes" Then
        
        Range(Cells(Target.Row, 1), Cells(Target.Row, 20)).Copy
        Sheets("Extract").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues

    End If
    End If
    End If

End Sub

This one indeed works like a charm!

Thank you once again for your help!

On the extract sheet I removed the Yes column entirely. Screenupdating addition is nice!
Haha yes, I know the feeling. I am also jumping between 3 workbooks, depending on the priority

Only thing left is the sorting of names by divisions in different sheets in the other topic. When you have a chance I will appreciate if you can help me out on that macro for me.