Discussion :

[luminused]

Bonjour,

J'ai un tableau avec 4 colonnes (ma base de données)

Code produit
Numèro de Fournisseur #
Quantité acheté par code
Periode de l'année

et j'aimerais pourvoir extraire dans le classeur Benchmark à partir de A7 les codes de produit qui se trouvent sur a2:a42541 de ma base de données avec la condition qu'ils doivent appartiennent au # de fournisseur requis sur C3 (Benchmark) sans les doublons et finalement si possible la somme de la quantité total acheté par code de produit sans tenir compte de la période de l'année.

Vous trouverez le fichier ci-joint Benchmark Project 2

Merci beaucoup à l'avance de tout votre aide

Ed

[parmi]

Bonjour,

De ce que j'ai compris, ceci devrait fonctionner.
Note que j'ai mis les quantités de la colonne ("C") de Base de données dans la colonne D de Benchmark (formule)

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
Sub VentesAnnuelles()
    Dim nbLignes As Long
 
'Vider le anciennes données
    nbLignes = Sheets("Benchmark").Cells(Rows.Count, "A").End(xlUp).Row
    If nbLignes > 6 Then Sheets("Benchmark").Range("A7:A" & nbLignes).ClearContents
 
'Réinitialiser les filtres
    Sheets("Base de Données").AutoFilterMode = False
    Sheets("Base de Données").Rows(1).AutoFilter
    Sheets("Base de Données").Columns("J").ClearContents
 
    nbLignes = Sheets("Base de Données").Cells(Rows.Count, "A").End(xlUp).Row
 
'Filtrer sur le numéro de fournisseur et copier en J   
    Sheets("Base de Données").Range("A1:D" & nbLignes).AutoFilter Field:=2, Criteria1:=Sheets("Benchmark").Range("C3")
    Sheets("Base de Données").Range("A2:A" & nbLignes).SpecialCells(xlCellTypeVisible).Copy
    Sheets("Base de Données").Range("J1").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
 
'Enlever les doublons   
    nbLignes = Sheets("Base de Données").Cells(Rows.Count, "J").End(xlUp).Row
    Sheets("Base de Données").Range("J1:J" & nbLignes).RemoveDuplicates Columns:=1, Header:=xlNo
 
'Copier dans Benchmark   
    nbLignes = Sheets("Base de Données").Cells(Rows.Count, "J").End(xlUp).Row
    Sheets("Base de Données").Range("J1:J" & nbLignes).Copy
    Sheets("Benchmark").Range("A7").PasteSpecial xlPasteValues
 
'Inscrire les formules    
    nbLignes = Sheets("Benchmark").Cells(Rows.Count, "A").End(xlUp).Row
    Sheets("Benchmark").Range("D7:D" & nbLignes).Formula = "=SUMIF('Base de Données'!A:A,A7,'Base de Données'!C:C)"
 
End Sub

[luminused]

Merci beaucoup pour ton aide PARMI
je vais l'essayer ce soir et si cela fonctionne (que je ne doute pas
je vais revenir pour mettre le mot: Resolu

Merci encore