Automatische Änderung eines Textes nach Eingabe

Private Sub Worksheet_Change(ByVal Target As Range)
Const b = "F11:H20,J11:L20"
Dim z As Range, ber As Range
Dim neu As Variant
Set ber = Intersect(Target, Range(b))
If Not ber Is Nothing Then
For Each z In ber
Select Case z.Value
Case 1: neu = 7
Case 2: neu = 7.5
Case 3: neu = 8
Case 4: neu = 8.5
Case 5: neu = 9
Case 6: neu = 9.5
Case 7: neu = 10
Case Else: neu = -1
End Select
If neu > 0 Then
On Error Resume Next
Application.EnableEvents = False
z.Value = neu
If Err.Number > 0 Then MsgBox Err.Description, vbCritical, "Fehler Nr." & Err.Number
On Error GoTo 0
Application.EnableEvents = True
End If
Next z
End If
End Sub