Help with simple cut and paste macro

[dvuppx]

i have a document which has a lot of information in sheet1, column a right up to column BI. i would like to be able to tick a box in column BI that then removes the row from sheet 1 and puts it into sheet 2, and adds a date. this is my formula so far, but im getting stuck at the text highlighted in BOLD, as it says my subscript is out of range. i have no idea how to fix that.




Sub Cutrows()
Dim WS1 As Worksheet
Dim WS2 As Worksheet
Set WS1 = ActiveSheet
Set WS2 = Worksheets("Sheet2")


firstrow = Selection.Rows(1).Row
RowCount = Selection.Rows.Count


NEXTROW = WS9.Cells(Rows.Count, 1).And(xlUp).Row + 1


WS1.Cells(firstrow, 1).Resize(RowCount, 25).Copy Destination:=WS2.Cells(NEXTROW, 1)


WS2.Cells(NEXTROW, 26).Resize(RowCount, 1).Value = Date


WS1.Cells(firstrow, 1).Resize(RowCount, 25).Delete shift:=xlUp
End Sub

 

[dvuppx]

so sorry. okay so. i have a row of data and i would like to be able to check a box at the end that states that someone is discharged, and then for that entry to move to the other sheet (discharges) and add the date on, if possible.

 

[Fluff]

What is the last column of data?

 

[dvuppx]

id like the last column, column BI to have a check that says Yes, or something to that effect, to say YES, id like to discharge now please. thank you for taking the time to help me.

 

[Fluff]

Right click on the tab for the sheet you want this to run on & select View Code
then paste this into the widow that opens

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
' dvuppx

    Dim Ws As Worksheet
    
Application.EnableEvents = False

    On Error GoTo Xit
    If Target.Column <> 61 Or UCase(Target.Value) <> "YES" Then GoTo Xit
    
    Set Ws = Sheets("Discharge")
    Target.EntireRow.Copy Ws.Range("A" & Rows.Count).End(xlUp).Offset(1)
    Target.EntireRow.Delete
Xit:
Application.EnableEvents = True

End Sub

Whenever you type yes into Column BI, that row will be copied to the Discharge sheet & deleted from the original sheet

 

[dvuppx]

OH my godd thank you so much! thank you thankkkk you. The only thing with that is it doesnt add a date to the end of the column when its moved over?

 

[Fluff]

The only thing with that is it doesnt add a date to the end of the column when its moved over?

oops, Forgot that bit. try this instead

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
'' dvuppx
'
    Dim Ws As Worksheet

Application.EnableEvents = False

    On Error GoTo Xit
    If Target.Column <> 61 Or UCase(Target.Value) <> "YES" Then GoTo Xit

    Set Ws = Sheets("Discharge")
    Target.EntireRow.Copy Ws.Range("A" & Rows.Count).End(xlUp).Offset(1)
    Ws.Range("BI" & Rows.Count).End(xlUp).Offset(, 1) = Date
    Target.EntireRow.Delete
Xit:
Application.EnableEvents = True

End Sub

 

[dvuppx]

thankkkkkkkkkkkkkkk youuuuuuuuuuuuuuuuuuuuu sooooooooooooooooooooooooo muchhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhh

 

[Fluff]

Glad to help & thanks for the feedback