Hello,
pourquoi sans macros ?
Sub FiltreAvance_Dynamique(PlageData, PlageCrit, FeuilleDest)
If FeuilleDest Is Nothing Then
MsgBox "La feuille '" & NomFeuille & "' n'existe pas.", vbCritical
Exit Sub
End If
'Effacer l'ancienne extraction
FeuilleDest.Cells.Clear
'Filtre avancé avec copie
PlageData.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=PlageCrit, _
CopyToRange:=FeuilleDest.Range("A1")
End Sub
Sub Filtre1()
Dim PlageData As Range, PlageCrit As Range, FeuilleDest As Worksheet
'Récupération des plages nommées
Set PlageData = Range("Data")
Set PlageCrit = Range("Filtre1")
Set FeuilleDest = Worksheets(Range("Dest1").Value)
FiltreAvance_Dynamique PlageData, PlageCrit, FeuilleDest
End Sub
Sub Filtre2()
Dim PlageData As Range, PlageCrit As Range, FeuilleDest As Worksheet
'Récupération des plages nommées
Set PlageData = Range("Data")
Set PlageCrit = Range("Filtre2")
Set FeuilleDest = Worksheets(Range("Dest2").Value)
FiltreAvance_Dynamique PlageData, PlageCrit, FeuilleDest
End Sub
Sub Filtre3()
Dim PlageData As Range, PlageCrit As Range, FeuilleDest As Worksheet
'Récupération des plages nommées
Set PlageData = Range("Data")
Set PlageCrit = Range("Filtre3")
Set FeuilleDest = Worksheets(Range("Dest3").Value)
FiltreAvance_Dynamique PlageData, PlageCrit, FeuilleDest
End Sub
Il suffit d'appuyer sur les boutons Filtre pour remplir les feuilles de destination.
Ami calmant, J.P