Private Sub Worksheet_Change(ByVal Target As Range)
Dim n As Range
Dim c As Range
Dim NextRow As Long
Dim SheetName As String
Set n = Intersect(Target, Columns("N"), Rows("2:" & Rows.Count))
If Not n Is Nothing Then
For Each c In n
SheetName = c.Offset(0, -11).Value
If SheetName <> "" And c.Value = "Completed" Then
NextRow = Sheets(SheetName).Range("A" & Rows.Count).End(xlUp).Row + 1
c.EntireRow.Copy Destination:=Sheets(SheetName).Range("A" & NextRow)
c.EntireRow.Copy Destination:=Sheets("Hist").Range("A" & NextRow)
Rows(Target.Row).Delete
End If
Next c
End If
End Sub
Bookmarks