Extraction en fonction de la date

Bonjour le forum,

A partir du fichier en PJ je souhaiterais extraire Les Noms des étuduants qui son reseve a héberge dand une date pricise ,

Le macro sert a filtrer et extraire les étudiants qui sont réserve pour prise en charge .

Je mets un fichier pour donner une idée, dans la feuille BDD plusieurs colonnes avec des données .

Veuillez voir la pièce ci-jointe pour plus de renseignements.

Je vous remercie à l'avance !

Cordialement,

Bonjour

Ce que vous voulez c'est la liste des étudiants dont un R est mis dans la colonne correspondant à la date en cellule E6 de la feuille Liste. Juste ?

Cordialement

Bonjour le forum

Bonjour Dan et Merci de votre attention,

vous joint exemple du résultat souhaité pour bien eclairer

re,

Merci mais il suffisait de juste répondre à ma question par oui ou non

Mettez ce code dans un module et associez-le à votre bouton Filtre

Sub filtrer()
Dim c As Range
Dim prem As String
Dim j As Integer, dlg As Integer
Dim col As Byte

With Sheets("Liste")
    dlg = .Range("A" & Rows.Count).End(xlUp).Row
    If dlg > 9 Then .Range("A10:F" & dlg).ClearContents
End With

With Worksheets("BDD")
    dlg = .Range("A" & Rows.Count).End(xlUp).Row
    col = WorksheetFunction.Match(Sheets("Liste").Range("E6"), .Rows(7).EntireRow, 0)

    With .Range(.Cells(7, col), .Cells(dlg, col))
        Set c = .Find("R", LookIn:=xlFormulas, LookAt:=xlWhole)
        If Not c Is Nothing Then
            j = 10
            prem = c.Address
            Do
                With Sheets("Liste")
                    .Cells(j, 1) = Worksheets("BDD").Cells(c.Row, 1)
                    .Cells(j, 2) = Worksheets("BDD").Cells(c.Row, 2)
                    .Cells(j, 3) = Worksheets("BDD").Cells(c.Row, 3)
                    .Cells(j, 4) = Worksheets("BDD").Cells(c.Row, 4)
                    .Cells(j, 5) = Worksheets("BDD").Cells(c.Row, 5)
                    .Cells(j, 6) = Worksheets("BDD").Cells(c.Row, 6)
                End With
                j = j + 1
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And prem <> c.Address
        End If
    End With
End With
End Sub

Le code efface toujours avant d'importer les données. votre bouton effacer n'est plus nécessaire

Choisissez la date en E6 dans la feuille Liste puis cliquez sur le bouton Filtre

Rem : on pourrait éviter le bouton Filtre et faire en sorte que le code soit exécuté sur changement de votre date dans la liste déroulante. A voir si intérêt...

Si ok, pensez à -_>

Cordialement

Bonjour le forum

Bonjour Dan

Je vous remercie beaucoup.

Cela fonctionne parfaitement

Merci beaucoup de votre réponse

Bien cordialement,

Re bonjour

Petite remarque : Dans la colonne A de la liste, je souhaite avoir un compteur de lignes (incrustation automatique).

Merci

Bonjour,
Une proposition avec la remarque (judicieuse) de Dan, que je salue, avec un index des lignes.
Procédure évènementielle à copier dans le module de la feuille Liste.
Cdlt.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lastCol As Long, lastRow As Long, I As Long, J As Long, k As Long
Dim tbl, arr(), dt

    If Target.Address = "$E$6" Then
        Me.Cells(9, 1).CurrentRegion.Offset(1).ClearContents
        dt = Me.Cells(6, 5).Value2
        tbl = Worksheets("BDD").Cells(9, 1).CurrentRegion.Value2
        For I = 2 To UBound(tbl)
            For J = 7 To UBound(tbl, 2)
                If tbl(I, J) = "R" And tbl(1, J) = dt Then
                    ReDim Preserve arr(6, k + 1)
                    arr(0, k) = k + 1
                    arr(1, k) = tbl(I, 2)
                    arr(2, k) = tbl(I, 3)
                    arr(3, k) = tbl(I, 4)
                    arr(4, k) = tbl(I, 5)
                    arr(5, k) = tbl(I, 6)
                    k = k + 1
                End If
            Next J
        Next I
        If k > 0 Then Me.Cells(10, 1).Resize(k, 6).Value = Application.Transpose(arr)
    End If

End Sub

Bonjour Jean-Eric

Bonjour Dan

Bonjour Le forum

Les deux solutions sont parfaites et je vais garder les deux solutions.

Je vous remercie pour vos efforts

Cordialement,

Bonjour Zinelamri, Jean Eric

Dans la colonne A de la liste, je souhaite avoir un compteur de lignes (incrustation automatique).

Actuellement vous avez le numéro qui se trouve en colonne A de la feuille BDD

Vous voulez une colonne supplémentaire ou simplement avoir un numéro séquentiel de 1 à x ?

EDIT :

Si ce n'est qu'avoir un numéro séquentiel, allez dans le code et remplacez la ligne

.Cells(j, 1) = Worksheets("BDD").Cells(c.Row, 1)

par ceci

.Cells(j, 1) = j - 9

Si vous voulez aussi exécuter le code depuis la cellule E6, faites un click droite sur l'onglet Liste, puis choisir "Visualiser le code".
Ensuite mettez ce code dans la fenêtre :

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("E6")) Is Nothing Then
    Call filtrer
End If
End Sub

Avec ce code vous avez deux choix pour l'exécution :
soit via le choix dans la liste de validation en E6 dans la feuille Liste
soit via un bouton auquel vous avez associé le code "Filtrer" comme je vous ai expliqué de faire dans mon post précédent.

Dites-mois