Bonjour à tous

J'aimerais réaliser une feuille de "listing" qui récupère des données d'une feuille "base" en fonction de certains critètres (dates, etc...). Mais je bloque sur la philosophie (méthode ) à employer.

Explications:

Ma feuille "base", se compose d'enregistrements unique sur chaque ligne

ex:

date nom commande produit
16/06/2011 Martin 1000 C-1
16/06/2011 Martin 1000 C-2
17/06/2011 Dupont 1001 C-3
18/06/2011 Durand 1002 C-4
18/06/2011 Durand 1002 C-5
18/06/2011 Durand 1002 C-6
25/06/2011 Pignon 1003 C-7

Et j'aimerais avoir une feuille de lisitng qui se compose ainsi:

date nom commande produits
16/06/2011 Martin 1000 C-1 à C-2
17/06/2011 Dupont 1001 C-3
18/06/2011 Durand 1002 C-4 à C-6
25/06/2011 Pignon 1003 C-7

Je désire obtenir ce résultat en fonction du mois et de l'année que je sélectionne dans une USF (ça c'est ok pas de pb).

Je pense qu'il faut effectuer un filtrage sur la feuille "base" pour pouvoir récupérer les données, mais je ne vois pas comment faire pour obtenir ce résultats.

J'ai ce code qui me permet de faire un filtrage et un rapatriment de données sur une autre feuille, j'essaye de m'en inspirer mais je bloque.

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
Private Sub Worksheet_Change(ByVal Target As Range)
Dim R As Range, Rng As Range
Dim CR As Integer, col As Integer, OC As Integer
 
'macro enregistreé le 14/06/2011 par 
 
If Not Intersect(Target, [C2]) Is Nothing Then
 
'1/application du filtre sur la feuille "Base"
 
    If Range("C2").Value <> "" Then
        Range("A15:B39,C13:U39,C9:F11,E42:F43,R11:U11,F2").ClearContents 'nettoyage des données de la feuille "Bulletin"
        With Sheets("Base")
            .Range("A3:AX10000").AutoFilter Field:=3, Criteria1:=Target.Value 'filtre de la zone définie en fonction de la valeur C2 de la feuille "Bulletin"
            Set Rng = .Cells(3, 3).CurrentRegion 'définition des donnée à transférer sur la base de la troisième colonne (demandeur)
                On Error GoTo EmptyFilter 'si le filtre ne renvoie pas de valeur alors une erreur survient, on décide donc de sortir de la procédure
                Set Rng = Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible)
                    On Error GoTo 0 'remise à zero du gestionnaire d'erreur
        End With
 
'2/traitement des différentes informations générales de la demande à tranférer
 
        With Sheets("Bulletin")
            For Each R In Rng
                If Not R.Row = 3 Then 'application des données de la feuille "Base" sur la feuille "Bulletin"
                    .Range("F2") = R.Offset(0, 4) 'Numéro de SAT
                    .Range("C9") = R.Offset(0, 1) 'Demandeur
                    .Range("C10") = R.Offset(0, 10) 'Date d'émission
                    .Range("C11") = R.Offset(0, 3) 'Compte d'imputation
                    .Range("R11") = R.Offset(0, 1) 'Destinataire (même personne que le demandeur)
                    .Range("E42") = R.Offset(0, 9) 'Chimiste
                    .Range("E43") = R.Offset(0, 0) 'Date de réception
                    .Range("A15").Offset(CR, 0) = R.Offset(0, 11) 'Repère laboratoire
                    .Range("B15").Offset(CR, 0) = R.Offset(0, 12) 'Repère demandeur
 
'3/traitement des différentes informations concernant les repères et les éléments (entêtes et résultats) à transférer pour le numéro de demande
 
                    For OC = 14 To 50 'traitement des entêtes colonnes N (14) à AX (50)
                        If Not Application.WorksheetFunction.Subtotal(9, Sheets("Base").Columns(OC)) = 0 Then
                            .Range("C13").Offset(0, col) = Sheets("Base").Cells(2, OC) 'initulés des éléments
                            .Range("C14").Offset(0, col) = Sheets("Base").Cells(3, OC) 'unités des éléments
                            .Range("C15").Offset(CR, col) = R.Cells(1, OC) 'résultats des analyses pour la demande choisie
                            col = col + 1
                        End If
                    Next OC
                    CR = CR + 1 'incrémentation de l'offset de ligne
                    col = 0 'remise à zéro de l'offset de colonne
                End If
            Next R
        End With
 
        With Sheets("Base")
            .AutoFilterMode = False 'arrêt du filtrage de la feuille "Base"
        End With
        Else
            Range("A15:B39,C13:U39,C9:F11,E42:F43,R11:U11,F2").ClearContents 'nettoyage des données de la feuille "Bulletin"
    End If
End If
Exit Sub
EmptyFilter:
MsgBox "pas de correspondance"
End Sub
J'ai commencer à faire le code

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
Private Sub Worksheet_Change(ByVal Target As Range)
Dim R As Range, Rng As Range
Dim CR As Integer, col As Integer, OC As Integer
 
'macro enregistreé le 14/06/2011 par MATHIEU CHOLVIN
 
If Not Intersect(Target, [B2]) Is Nothing Then
 
'1/application du filtre sur la feuille "Base"
 
        mois = Month(Range("B2")) 'définition du mois choisit dans le listing
        annee = Year(Range("B2")) 'définition de l'année choisit dans le listing
        datemin = DateSerial(annee, mois, 1) 'définition de la variable "datechx" en fonction des variables "annee" et "mois"
        datemax = DateSerial(annee, mois + 1, 1) 'définition de la variable "datechx" en fonction des variables "annee" et "mois"
        ldatemin = CLng(datemin) 'définition de la variable "ldatechx" (date sous format numérique windows)
        ldatemax = CLng(datemax) 'définition de la variable "ldatechx" (date sous format numérique windows)
        If Range("B2").Value <> "" Then
            Range("A12:H36").ClearContents 'nettoyage des données de la feuille "Bulletin"
 
            With Sheets("Base")
                .Range("A3:AX10000").AutoFilter Field:=1, Criteria1:=">=" & ldateini, Operator:=xlAnd, Criteria2:="<" & ldatefin 'filtre de la zone définie en fonction de la valeur des dates de début et de fin
                Set Rng = .Cells(3, 1).CurrentRegion 'définition des donnée à transférer sur la base de la troisième colonne (demandeur)
                    On Error GoTo EmptyFilter 'si le filtre ne renvoie pas de valeur alors une erreur survient, on décide donc de sortir de la procédure
                    Set Rng = Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible)
                        On Error GoTo 0 'remise à zero du gestionnaire d'erreur
            End With
 
'2/traitement des différentes informations générales de la demande à tranférer
 
            With Sheets("Listing")
Mais boilà il me le plus important et je suis un peu perdu, quelqu'un a t-il une idée pour me permettre de progresser?

Merci pour votre aide et bonne journée