XL 2016 filtre avec critère ou extraite

job75 à dit:

Bonsoir Seddiki_adz,

Il suffit d'utiliser le filtre avancé, voyez le fichier joint.

Le code de Feuil2 :

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [D3]) Is Nothing Then Exit Sub
Dim destination As Range, critere As Range
[D3].Select
Set destination = [A7:G7]
Application.ScreenUpdating = False
destination.Offset(1).Resize(Rows.Count - destination.Row).Clear 'RAZ
With Sheets("BDD").[A6].CurrentRegion
    Set critere = .Cells(1, .Columns.Count + 2).Resize(2)
    critere = Application.Transpose([C3:D3])
    If critere(2) = "" Then critere(2) = "#N/A"
    .AdvancedFilter xlFilterCopy, critere, destination 'filtre avancé copié
    critere = ""
End With
End Sub

Le code de Feuil3 :

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [E3]) Is Nothing Then Exit Sub
Dim destination As Range, critere As Range
[E3].Select
Set destination = [A6:E6]
Application.ScreenUpdating = False
destination.Offset(1).Resize(Rows.Count - destination.Row).Clear 'RAZ
With Sheets("BDD").[A6].CurrentRegion
    Set critere = .Cells(1, .Columns.Count + 2).Resize(2)
    critere = Application.Transpose([D3:E3])
    If critere(2) = "" Then critere(2) = "#N/A"
    .AdvancedFilter xlFilterCopy, critere, destination 'filtre avancé copié
    critere = ""
End With
End Sub

A+

Cliquez pour agrandir...