Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngCell As Excel.Range
Dim lr2 As Long
On Error GoTo ErrHandler
Application.EnableEvents = False
For Each rngCell In Target.Cells
Select Case rngCell.Column
Case 7
Select Case rngCell.Value
Case "Erledigt"
lr2 = Sheets("Archiv").Cells(Rows.Count, 1).End(xlUp).Row + 1
Rows(rngCell.Row).Copy
Sheets("Archiv").Rows(lr2).PasteSpecial Paste:=xlValues
Rows(rngCell.Row).Delete
Case "Dringend"
Cells(rngCell.Row, "C").Copy
Case "In Arbeit"
Cells(rngCell.Row, "C").Copy
End Select
End Select
Next
SafeExit:
Application.EnableEvents = True
Exit Sub
ErrHandler:
Call MsgBox(Err.Description, vbCritical, Me.Name & Err.Number, Err.HelpFile, Err.HelpContext)
GoTo SafeExit
End Sub