VBA : Filtre selon 2 critères

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 5 Then Range("D" & Target.Row) = Date
    Dim FeBase As Worksheet
    Dim Fe As Worksheet
    Dim Ligne As Long

    If Target.Count > 1 Then Exit Sub 'suite à une sélection multiple et suppression par exemple
    If Target.Column <> 19 Then Exit Sub 'colonne AA
    If Target.Row < 6 Then Exit Sub 'pas les lignes d'entêtes
  
    'si la valeur est 1, on lance le transfert
    If Target.Value = 1 Then
  
        Set FeBase = Worksheets("PENALITE")
  
        On Error Resume Next
        Set Fe = Worksheets(Cells(Target.Row, 2).Value)
  
        If Err.Number <> 0 Then
          
            'gèle l 'affichage
            Application.ScreenUpdating = False
          
            Set Fe = Worksheets.Add(, Sheets(Sheets.Count))
            Fe.Name = Cells(Target.Row, 2).Value
            Err.Clear
          
            're-sélectionne la feuille car la création mets le focus sur la nouvelle feuille
            FeBase.Select
          
            'rafraîchi
            Application.ScreenUpdating = True
  
         End If
      
        'transfert
        With Fe: Ligne = .Cells(.Rows.Count, 2).End(xlUp).Row: End With
  
        If Ligne = 1 And Fe.Cells(1, 2).Value = "" Then
        'Collage celulle A1
            Fe.Range(Fe.Cells(1, 1), Fe.Cells(2, 17)).Value = FeBase.Range(FeBase.Cells(5, 2), FeBase.Cells(5, 25)).Value
        End If
   'le Targetrow,25 change rien
  
        Fe.Range(Fe.Cells(Ligne + 1, 1), Fe.Cells(Ligne + 1, 17)).Value = FeBase.Range(FeBase.Cells(Target.Row, 2), FeBase.Cells(Target.Row, 25)).Value
  
    End If
  
End Sub

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
        If Not Application.Intersect(Target, Range("F8:G8")) Is Nothing Then
        Call filtre3
        End If
End Sub