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
Private Sub...
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
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
MerciBonsoir Seddiki_adz,
Il suffit d'utiliser le filtre avancé, voyez le fichier joint.
Le code de Feuil2 :
Le code de Feuil3 :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
A+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