Option Explicit

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 < .Range("DataGoal").Row Then
            rngGoalData.Offset(.Range("DataGoal").Row - 1, 0).Clear
        Else
            .Range("DataGoal").CurrentRegion.Clear
        End If

        Range("DataStart").CurrentRegion.AdvancedFilter _
                Action:=xlFilterCopy, _
                CriteriaRange:=.Range(.Range("DataCrit").Row & ":" & lngRows), _
                CopyToRange:=.Range("DataGoal"), _
                Unique:=False
    End With
ErrorHandler:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

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