Boucle copié-colle avec condition de valeur de cellule

Bonjour, je débute en VBA et j'ai du mal à faire fonctionner une macro. Je dois réaliser une macro qui permettrai de faire la synthèse de d'un ensemble d'articles d'un fichier Excel "Base_de_données" sur une feuille d'un autre fichier Excel "Synthèse_produit". Ce fichier ("Base_de_données") conséquent, comporte beaucoup de colonnes (date de création, code article, désignation article, code client...) et beaucoup de lignes ( chaque vente d’articles correspond a une ligne)...

J'ai à côté une feuille ou se trouve toutes les références(code article) de l’ensemble des articles qui nous intéressent et leurs désignations : "Référence_ensemble1"

Je voudrai réaliser une boucle qui parcours toute la colonne "AF"(colonne du code article) du fichier "Base_de_données" pour copier sa valeur et la coller dans une feuille d'un classeur différent "Synthèse_produit" seulement si le code article correspond à un code article présent dans les plages de cellules présentent dans "Référence_ensemble1".

Plage de données de codes produits dans "Référence_ensemble1" : B10 à B62

Description étape par étape :

--> On se place dans la feuille "Base_de_données"

Range "AF2".Select

--> On sélectionne les 8 premiers caractères de la 1ère cellule des codes articles(AF2)

-->Tant que la cellule sélectionnée de la colonne AF n'est pas vide répéter la boucle ( pour balayer tout le tableau)

While Is Empty...

-->Si la cellule sélectionnée a une valeur identique à un code produit de la feuille "Référence_ensemble1"( les 8er caractères seulement)

--> On copie la ligne entière de la cellule qui remplit le critère de valeur

ActiveCell.Row.Copy

--> On active la feuille de synthèse ou on recopie les lignes sectionnées "Synthèse_produit"

--> On se place sur la cellule B10 et on colle la cellule

Range("B10").select

ActiveSheet.Paste

-->On insère en B10 ce qui décale la cellule copiée d'une ligne vers le bas pour la suivante

Utilisation d'un "xlDown ???

Je suis novice donc j'ai un peu du mal à expliquer ce que je souhaite faire, si je n'ai pas été assez clair je suis disponible pour des précisions

Kevin

Salut UnknowViking,

à l'aveugle et en postulant que ta feuille 'Synthèse_produit' se trouve dans le MÊME classeur que les deux autres (pas trop suivi...).

Sinon, créer cette feuille (du moins pour le test du code) sous peine de bug!

Le code ci-dessous est à coller dans le module VBA de la feuille 'Base_de_données'.

Ensuite, double-clic sur cette même feuille pour démarrer la macro et... croisons les doigts que rien n'explose!

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tRef, tBDD, tExtract(), iRow!, iCol!, iIdx!
'
Cancel = True
'
iRow = Range("AF" & Rows.Count).End(xlUp).Row
iCol = Cells(1, Columns.Count).End(xlToLeft).Column
tBDD = Range("A2").Resize(iRow - 1, iCol).Value
'
tRef = Worksheets("Référence_ensemble1").Range("B10:B62").Value
'
For x = 1 To UBound(tBDD, 1)
    For y = 1 To UBound(tRef, 1)
        If Left(tBDD(x, 32), 8) = Left(tRef(y, 1), 8) Then
            iIdx = iIdx + 1
            ReDim Preserve tExtract(iCol, iIdx)
            For Z = 1 To UBound(tBDD, 2)
                tExtract(Z - 1, iIdx - 1) = tBDD(x, Z)
            Next
            Exit For
        End If
    Next
Next
'
Worksheets("Synthèse_produit").Range("B10").Resize(iIdx, iCol) = WorksheetFunction.Transpose(tExtract)
'
End Sub

A+

Rechercher des sujets similaires à "boucle copie colle condition valeur"