Filtre élaboré en VBA ne fonctionne pas

Bonjour à tous,

Je réalise pour mon entreprise une base de données de pointage des salariés, et j'ai besoin d'extraire dans une feuille, en vue d'imprimer et/ou de copier dans un nouveau classeur, les données de pointage entre 2 dates.

J'ai créé une boîte de dialogue dans laquelle le gestionnaire indique une date de début de relevé (dans une zone de texte nommée ztDateDébut) et une date de fin du relevé (ztDateFin). Ces données sont converties en date pour vérification avec CDate et envoyées dans 2 variables, respectivement valeurDateDébut et valeurDateFin.

Les données de pointage sont stockées dans une feuille nommée Données, et une feuille nommée Critères contient une zone de critères (deux cellules contenant le même intitulé de la colonnes contenant les dates de pointage : Date_pointage, et deux cellules en-dessous qui contiendront chacune les critères de date de début/fin). La zone de critères s'appelle CriteresReleveDateADate, et la 1ère cellule devant contenir la date de début s'appelle DateDébutRelevé et la 2ème DateFinRelevé.

Un peu plus loin sur cette même feuille, j'ai ma zone d'extraction (nommée Extraction_Relevé) qui est constituée d'une seule ligne contenant les intitulés des colonnes de ma base de données que je souhaite récupérer.

Lorsque j'essaye d'extraire moi-même les données avec, par exemple, comme critères : >=05/09/2020 et <=25/09/2020, cela fonctionne à merveille. Cependant, quand j'essaye de le faire en VBA, rien de ressort sur la zone d'extraction, comme si aucune donnée ne correspondait aux critères indiqués ! Et je n'ai aucun message d'erreur...

Voici le code que j'utilise dans le bouton Valider de ma boîte de dialogue :

'insertion des critères de la dlg vers la zone de critères
Sheets("Critères").Visible = -1
Sheets("Critères").Select
Application.Goto Reference:="DateDébutRelevé"
ActiveCell.Value = ">=" & valeurDateDébut
Application.Goto Reference:="DateFinRelevé"
ActiveCell.Value = "<=" & valeurDateFin

'extraction des données
Sheets("Données").Select
Selection.CurrentRegion.Select
plage = Selection.AddressLocal
Sheets("Critères").Select
Sheets("Données").Range(plage).AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Range("CriteresReleveDateADate"), CopyToRange:=Range( _
        "Extraction_Relevé"), Unique:=False

'sélectionner la zone d'extraction
Application.Goto Reference:="Extraction_Relevé"

'vérification que l'extraction n'est pas vide
contenu = ActiveCell.Offset(1, 0).Value
If contenu = "" Then
    MsgBox "Aucune donnée ne correspond à vos critères !", vbExclamation + vbOKOnly, "Relevé du " & valeurDateDébut & " au " & valeurDateFin
    GoTo suite
End If

Auriez-vous déjà rencontré ce problème ? J'ai essayé de mettre "Données!" & plage à la place de plage dans le filtre élaboré mais ça ne change rien...

Merci par avance de votre aide !

Bon dimanche à tous.

Bonjour,

Avec VBA, la très grande majorité des .Select sont néfastes !

Ce code (à adapter) fonctionne très bien :

Private Sub CommandButton1_Click()
Dim rngDonnees As Range
Dim rngCritere As Range

  Worksheets("Résultat").Cells.Clear
  Set rngDonnees = Worksheets("Données").Range("a1").CurrentRegion
  Set rngCritere = Worksheets("Critères").Range("a1").CurrentRegion
  rngDonnees.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=rngCritere, Unique:=False
  rngDonnees.Copy Destination:=Worksheets("Résultat").Range("a1")
  If Worksheets("Données").FilterMode Then Worksheets("Données").ShowAllData
  Worksheets("Résultat").Activate

End Sub

Bonjour à tous

Je conseille de mettre la source sous forme de tableau structuré

Le problème vient du traitement des dates par VBA et de ta définition de la plage à filtrer (currentregion d'une feuille cela n'existe pas)

N'ayant pas le début du code qui définit les dates je les ai définies dans le code mais à adapter en respectant la conversion

Sub test()
valeurDateDébut = CLng(CDate("09/01/2020"))
valeurDateFin = CLng(CDate("25/02/2020"))
[DateDébutRelevé] = ">=" & valeurDateDébut
[DateFinRelevé] = "<=" & valeurDateFin

'extraction des données
With Sheets("Données")
    .ListObjects(1).Range.AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=[CriteresReleveDateADate], CopyToRange:=[Extraction_Relevé], Unique:=False

'vérification que l'extraction n'est pas vide
    If [Extraction_Relevé].Cells(1, 1).Offset(1, 0) = "" Then
        MsgBox "Aucune donnée ne correspond à vos critères !", vbExclamation + vbOKOnly, "Relevé du " & valeurDateDébut & " au " & valeurDateFin
        GoTo suite
    End If
End With
End Sub

Merci bien, je vais essayer dès mardi au boulot, et je vous dit si ça fonctionne !

Bonjour,

J'ai pu faire un essai cet après-midi et ce fut convainquant ! J'ai juste utilisé la fonction CLng sans rien changer d'autre à mon code (en grande partie obtenu grâce à l'enregistreur de macros), et ça fonctionne à merveille. Et ça m'a rappelé que j'avais déjà utilisé cette technique de remplacer la date par sa valeur numérique avec les signes de comparaison logique à l'époque où je donnais des cours sur Excel, il y a fort fort longtemps... Merci en tout cas pour votre aide !

Bonjour

Yvan974 a écrit :

J'ai juste utilisé la fonction CLng sans rien changer d'autre à mon code (en grande partie obtenu grâce à l'enregistreur de macros)

Je note donc que les conseils :

• tableaux structurés
• ni select, ni goto et précisions sur les objets manipulés

ont été ignorés...

Je doute fort que

Selection.CurrentRegion.Select

fonctionne dans tous les cas...

Curieux que les bonnes pratiques ne retiennent pas l'attention de quelqu'un qui transmettait...

Ce n'est pas que je les ignore, mais je fais ça en plus de mon travail, sur mon lieu de travail, quand j'ai cinq minutes par ci par là, et malheureusement je n'ai pas suffisamment de temps pour tout essayer. Vos précieux conseils ne sont pas perdus !

J'ai eu un peu de temps pour mettre en application vos conseils, et au final c'est vrai que c'est intéressant et plus pratique !

Encore merci pour vos conseils.

Bonjour et merci du retour