Code von Beverly erweitern

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'* 09.02.08,11.03.08,31.03.08                     *
'* erstellt von Karin, http://beverly.excelhost.de*
'* beverly@excelhost.de                           *
Dim raBereich As Range
Dim raZelle As Range            ' Variable für die Zelle als Range
'   Wirkung des Codes auf Zeile 1 der Tabelle im Filterbereich zulassen
Set raBereich = Intersect(Target, Range(Cells(3, ActiveSheet.AutoFilter.Range(1).Column), _
Cells(3, ActiveSheet.AutoFilter.Range(1).Column + ActiveSheet.AutoFilter.Filters.Count - _
1)))
'   Eingabe erfolgte im festgelegten Bereich
If Not raBereich Is Nothing Then
'       Bildschirmaktualisierung aus
Application.ScreenUpdating = False
'       Reaktion auf Eingabe abschalten
Application.EnableEvents = False
'       Schleife über alle Zellen der Zeile 1 der Tabelle
For Each raZelle In raBereich
'           Bezieht sich auf den Filterbereich
With ActiveSheet.AutoFilter.Range
'               Eingabe wurde gelöscht
If raZelle = "" Then
'                   Autofilter für das betreffende Fald zurücksetzen
.AutoFilter Field:=raZelle.Column + 1 - ActiveSheet.AutoFilter.Range(1). _
Column
'                   in die betreffende Zelle eintragen
raZelle = "? ? ?"
Else
'                   Suchkriterium ist eine Zahl
If IsNumeric(raZelle) Then
'                       Autofilter für das betreffende Feld setzen, Filterkriterium "entspricht" _
.AutoFilter Field:=raZelle.Column + 1 - ActiveSheet.AutoFilter.Range(1). _
Column, _
Criteria1:="=" & raZelle
'                   Suchkriterium ist ein Datum
ElseIf IsDate(raZelle) Then
'                       Autofilter für das betreffende Feld setzen
'                       es werden 2 Kriterien verwendet, weil mit Kriterium "=" das Datum nicht  _
gefiltert wird
.AutoFilter Field:=raZelle.Column + 1 - ActiveSheet.AutoFilter.Range(1). _
Column, _
Criteria1:=">=" & raZelle.Value2, Criteria2:="