Discussion :

[stanca]

Bonjour,

Je cherche à savoir comment ça fonctionne car c'est très intéressant pour une utilisation ultérieure :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Column >= 1 And Target.Column <= 7 And Target.Row > 8 Then
    Application.EnableEvents = False
     [critère].ClearContents
    'On Error Resume Next
    'ActiveSheet.ShowAllData
    ' Maj Listes
    [E8:E1000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("Listes").[B1], Unique:=True
    Sheets("Listes").[B1:B1000].Sort Key1:=Sheets("Listes").[B2], Order1:=xlAscending, Header:=xlGuess
 
    [C8:C1000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("Listes").[C1], Unique:=True
    Sheets("Listes").[C1:C1000].Sort Key1:=Sheets("Listes").[C2], Order1:=xlAscending, Header:=xlGuess
 
    [F8:F1000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("Listes").[D1], Unique:=True
    Sheets("Listes").[D1:D1000].Sort Key1:=Sheets("Listes").[D2], Order1:=xlAscending, Header:=xlGuess
    Application.EnableEvents = True
  End If
  'Extraction
  If Not Intersect(Range("critère"), Target) Is Nothing Then
    Application.EnableEvents = False
    Range("A8:G10000").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=[F1:F2]
    Application.EnableEvents = True
  End If
End Sub

Merci pour votre aide.