Code sperrt Zellen

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect Password:="befaster"
Dim rngEingabe As Range
Dim sFormel$, lngRow&
'Wirkungsbereich anpassen
Set rngEingabe = Intersect(Range("C2:AZ2000"), Target)
'Keine Zelle im Wirkungsbereich?
If Not rngEingabe Is Nothing Then
'Schleife über Eingabebereich
For Each rngEingabe In rngEingabe
If rngEingabe  "" Then 'ist Zelle nicht leer
lngRow& = rngEingabe.Row 'Zeile der Zelle für Formel
'Formel zusammenbauen
sFormel$ = "=(LOWER($B" & lngRow& & ")=""x"")*(COUNTA($C" & lngRow& - 1 & ":$AZ" & lngRow& - _
1 & ")=50)"
If Not CBool(Evaluate(sFormel)) Then 'Ergebnis der Formel mit Prüfung
Application.EnableEvents = False 'events aus
Application.Undo 'Handeingabe rückgängig
MsgBox "Before you can start editing this line, please fill out all cells in  _
previous row!", vbCritical, "Cancel action" 'Fehlermeldung
Application.EnableEvents = True 'events an
Exit Sub 'aussteigen
End If
End If
Next rngEingabe
End If
'keine Zeilenumbrüche
If Not Intersect(Target, Range("B2:CA2000")) Is Nothing And Target.Count = 1 Then
If InStr(Target, Chr(10)) Then
Target = Replace(Target, Chr(10), " ")
End If
End If
'länder
If Target.Column = 3 And Target.Row > 1 Then
With Application
.EnableEvents = False
Target = .Index(Sheets("Data_Tab").Columns(1), _
.Match(Target, Sheets("Data_Tab").Columns(2), 0))
.EnableEvents = True
End With
End If
' nur inhalte einfügen
Application.EnableEvents = False
If InStr(1, Application.CommandBars("Edit").Controls(1).Caption, "Einfügen") > 0 Then
Application.Undo
Selection.PasteSpecial xlPasteValues
End If
Application.EnableEvents = True

ActiveSheet.Protect Password:="befaster", AllowFormattingColumns:=True, AllowFiltering:=True
End Sub