Macro filtre VBA

Bonjour,

Je souhaite créer un filtre en fonction du contenu d'une cellule ? Je ne sais pas si c'est possible. Par exemple, dans la colonne A j'ai des dates, et je voudrais que le filtre se fasse automatiquement en fonction du contenu de la cellule C2.

Si je tape 18/01/2017 dans la C2, je souhaite pouvoir voire que les éléments correspondant à cette date sur la feuille de mon classeur.

je vous joint un petit fichier comme exemple merci de m'aider

siga

Salut Siga,

une façon de faire, en cachant les lignes...

• tu encodes la date en [C2] : les lignes non concernées par la date en [C2] se cachent ;
• tu cliques à nouveau [C2] : les lignes réapparaissent et [C2] se vide.

Private Sub Worksheet_Change(ByVal Target As Range)
'
If Target.Address = [C2].Address And IsDate([C2]) = True Then
    Application.ScreenUpdating = False
    '
    iRow = Range("A" & Rows.Count).End(xlUp).Row
    Cells(1, Columns.Count) = iRow
    For x = 5 To iRow
        If Cells(x, 1) <> [C2] Then Rows(x).Hidden = True
    Next
    '
    Application.ScreenUpdating = True
End If
'
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
If Target.Address = [C2].Address And IsDate([C2]) = True Then
    Application.ScreenUpdating = False
    '
    [C2] = ""
    Rows("5:" & Cells(1, Columns.Count)).Hidden = False
    '
    Application.ScreenUpdating = True
End If
'
End Sub

A+

Bonjour

curulis57 je vous remercie pour votre suggestion mais j'a le problème suivant:

en introduisant votre code dans mon fichier j'ai le message suivant qu’apparaît

Erreur de compilation: Non ambigu détecté Worksheet_Change | Excel ...

voila le code que j'ai auparavant

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Count > 1 Then Exit Sub

Select Case Target.Column

Case 1, 2, 7

If Target.Row > 1 Then

If IsEmpty(Target) Then Exit Sub

Application.EnableEvents = False

With Target

.NumberFormat = "General"

.Value = ConvertToDate(Target.Value)

.NumberFormat = "m/d/yyyy"

End With

Application.EnableEvents = True

End If

End Select

End Sub

SVP comment regrouper les deux code ou pouvons changerde nom pour résoudre ce problème

Bonjour Siga,

ça devrait aller ainsi! 8)

A tester, bien évidemment!

Private Sub Worksheet_Change(ByVal Target As Range)
'
If Target.Count > 1 Then Exit Sub
'
If Not Intersect(Target, Union(Range("A:B"), Range("H:H"))) Is Nothing Then
    If Target.Row > 1 Then
        If IsEmpty(Target.Value) Then Exit Sub
        Application.EnableEvents = False
        With Target
            .NumberFormat = "m/d/yyyy"
            .Value = CDate(Target.Value)
        End With
        Application.EnableEvents = True
    End If
End If
'
If Target.Address = [C2].Address And IsDate([C2]) = True Then
    Application.ScreenUpdating = False
    '
    iRow = Range("A" & Rows.Count).End(xlUp).Row
    Cells(1, Columns.Count) = iRow
    For x = 5 To iRow
        If Cells(x, 1) <> [C2] Then Rows(x).Hidden = True
    Next
    '
    Application.ScreenUpdating = True
End If
'
End Sub

Bon travail!

A+

Bonjour;

curulis57 merci pour ta contribution, je travaillerais sur ça.

Cordialement

siga