Gültigkeitsprüfung

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim rngZelle As Range, rngBereich As Range, bolFehler As Boolean
If UCase(Sh.Name)  "Vorgaben" Then
Set rngBereich = Intersect(Sh.Range("A1:B20,A23:B42"), Target)
If Not rngBereich Is Nothing Then
For Each rngZelle In rngBereich
If IsNumeric(rngZelle) Then
If rngZelle  1 Then bolFehler = True
ElseIf Application.CountIf(Sheets("Vorgaben").Range("A1:B10"),rngZelle) = 0 _
Then
bolFehler = True
End If
If bolFehler Then
MsgBox "Achtung Fehler!"
Application.Undo
Exit Sub
End If
Next
End If
End If
End Sub