Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
Dim Rstart As Range, Rend As Range, Rdest As Range
Dim destinationLastRow As Long, sSize As Long
Set Rstart = Range("A" & Target.Row)
Set Rend = Range("O" & Target.Row)
If Target.Column = 4 Then
If Target.Value = "Complete" Then
With Sheet6 'Historic Register
destinationLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With
With Range(Rstart, Rend.Offset(, -1))
sSize = .Count
.Copy
End With
Set Rdest = Sheets("Historic Register").Range("A" & destinationLastRow).Resize(1, sSize)
Rdest.PasteSpecial xlPasteValues
Target.EntireRow.Delete Shift:=xlShiftUp
'Sheet6.Range("B" & Target.Row & ":J" & Target.Row & "").ClearContents
'Sheet6.Range("B" & Target.Row & ":J" & Target.Row & "").ClearContents
Application.CutCopyMode = False
'Rstart.Offset(1).Select
End If
End If
'New Part
Dim Lastrow As Long
Lastrow = Cells(Rows.Count, "K").End(xlUp).Row
If Not Intersect(Target, Range("K1:K" & Lastrow)) Is Nothing Then
If Target.Value = "Malfunction" Then Target.Offset(, 2).Value = Target.Offset(, -1).Value
End If
End Sub