Discussion :

[kit2412]

Bonjour à tous,

Je joins un fichier dans lequel j'explique mon besoin.
Ce fichier comporte déjà un filtre par VBA mais j'ai besoin d'un 2ème filtre.
Je vous remercie par avance pour votre aide.

[BlueMonkey]

Bonsoir,

Les macros ci-dessous masques les lignes manuellement.
Une autre solution est d'utiliser des filtres automatiques.

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
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
Private Sub Worksheet_Change(ByVal Target As Range)
 
   If Target.Count > 1 Or Target <> [E8] Then Exit Sub
   Application.ScreenUpdating = False
    MasqueToutesLesColonnesSaufLot Sheets("LOTTAGE").Range("K2"), Target.Value
    MasqueLesLignesSansX Sheets("LOTTAGE").Range("K2"), Target.Value
   Application.ScreenUpdating = True
End Sub
 
Sub MasqueToutesLesColonnesSaufLot(firstLot As Range, ByVal lot As String)
    Dim plageAllLot As Range
    Dim plageLotCible As Range
    With firstLot.Worksheet
        .UsedRange.EntireColumn.Hidden = False
        Set plageAllLot = .Range(firstLot, .Cells(firstLot.Row, Columns.Count).End(xlToLeft).Offset(0, 2))
    End With
 
    If UCase(lot) <> "TOUS" Then
        Dim l As Range
        For Each l In plageAllLot
            If l = lot Then
                With l.Worksheet
                    Set plageLotCible = .Range(l.Offset(0, -5), .Cells(l.Row, l.Column + l.Columns.Count + 1))
                End With
 
                Exit For
            End If
        Next l
 
        plageAllLot.EntireColumn.Hidden = True
        If Not (plageLotCible Is Nothing) Then plageLotCible.EntireColumn.Hidden = False
    End If
End Sub
 
Sub MasqueLesLignesSansX(firstLot As Range, ByVal lot As String)
    Dim plageAllLot As Range
    Dim plageLotCible As Range
    With firstLot.Worksheet
        .UsedRange.EntireRow.Hidden = False
        Set plageAllLot = .Range(firstLot, .Cells(firstLot.Row, Columns.Count).End(xlToLeft).Offset(0, 2))
    End With
 
    If UCase(lot) <> "TOUS" Then
        Dim l As Range
        For Each l In plageAllLot
            If l = lot Then
                With l.Worksheet
                    Set plageLotCible = l.Cells(5, 3)
                End With
 
                Exit For
            End If
        Next l
 
    With firstLot.Worksheet
        Set plageLotCible = .Range(plageLotCible, plageLotCible.End(xlDown)).Offset(0, -7)
    End With
 
    Dim cell As Range
    For Each cell In plageLotCible
        If cell.Value = "" Then cell.EntireRow.Hidden = True
    Next cell
    End If
End Sub