Ausführung durch Button

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Range("DataStart").Parent.Name  Sh.Name Then
Dim rngCrit As Range
On Error Resume Next
Set rngCrit = Sh.Range("DataCrit")
On Error GoTo 0
If Not rngCrit Is Nothing Then
Filter Sh
End If
End If
ErrorHandler:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Range("DataStart").Parent.Name  Sh.Name Then
Dim rngAct  As Range
Set rngAct = ActiveCell
On Error GoTo ErrorHandler
Set Target = Intersect(Target, Sh.Range(Sh.Range("DataCrit").Row & ":" & Sh.Range(" _
DataGoal").Row - 1).EntireRow)
If Not Target Is Nothing Then
Filter Sh
Application.Goto rngAct
End If
End If
ErrorHandler:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Private Sub Filter(Sh As Object)
On Error GoTo ErrorHandler
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim lngRows     As Long
Dim rngGoalData As Range
With Sh
lngRows = .Range(.Range("DataCrit").Row & ":" & .Range("DataGoal").Row - 1). _
Find(What:="*", _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
Set rngGoalData = .Range("DataGoal").CurrentRegion
If rngGoalData(1, 1).Row 

Public Sub ReSharpen()
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub