Copie de cellules suivant critères

Bonjour à toutes et à tous,

L'objectif de ma demande est de pouvoir copier les cellules C, D , L, M et N de la feuille "PMB" vers la feuille "MVTS" suivant 2 critères.

Actuellement, le bouton "COPIER" permet la copie mais sans critères. Je ne sais pas si j'ai bien fait mais j'ai privilégié l'utilisation de tableaux pour leur rapidité car le nombre de lignes à vérifier dans les 2 feuilles risque de grossir rapidement.

Voici les critères pour la copie des cellules de PMB vers MVTS :

1) Le produit n'existe pas dans MVTS
2) Le produit existe dans MVTS mais avec un numéro de réception différent

Je vous remercie d'avance pour votre aide

Private Sub MAJ_MVTS_STOCK_Click()

    Dim derlig_mvts, derlig_entrees As Integer
    Dim dt_jour As Date
    Dim i, j, k As Integer
    Dim plage_mvts As Range
    Dim plage_entrees As Range
    Dim tableau_entrees()
    Dim tableau_mvts()

    dt_jour = Format(Now(), "dd-mm-yyyy")

    derlig_mvts = Sheets("MVTS").Range("C" & Rows.Count).End(xlUp).Row

    derlig_entrees = Sheets("PMB").Range("DERLIG_ENTREES").Row - 1

    Set plage_mvts = Sheets("MVTS").Range("C2:C" & derlig_mvts)

    Set plage_entrees = Sheets("PMB").Range("C6:C" & Sheets("PMB").Range("DERLIG_ENTREES").Row - 1)

    ReDim tableau_entrees(derlig_entrees, 14)

    For i = 2 To derlig_entrees

        tableau_entrees(i, 3) = Sheets("PMB").Range("C" & i).Value  ' Produit
        tableau_entrees(i, 4) = Sheets("PMB").Range("D" & i).Value  ' Description
        tableau_entrees(i, 12) = Sheets("PMB").Range("L" & i).Value ' N° Réception
        tableau_entrees(i, 13) = Sheets("PMB").Range("M" & i).Value ' Unité
        tableau_entrees(i, 14) = Sheets("PMB").Range("N" & i).Value ' Qté

    Next i

    ReDim tableau_mvts(derlig_mvts, 4)

    For j = 2 To derlig_mvts

        tableau_mvts(j, 3) = Sheets("MVTS").Range("C" & j).Value ' Produit
        tableau_mvts(j, 4) = Sheets("MVTS").Range("E" & j).Value ' N° Réception

    Next j

    For k = 2 To Sheets("PMB").Range("DERLIG_ENTREES").Row - 1

        derlig_mvts = Sheets("MVTS").Range("C" & Rows.Count).End(xlUp).Row

        Sheets("MVTS").Cells(derlig_mvts + 1, 1).Value = "C1"
        Sheets("MVTS").Cells(derlig_mvts + 1, 2).Value = dt_jour
        Sheets("MVTS").Cells(derlig_mvts + 1, 3).Value = Sheets("PMB").Cells(k, 3).Value
        Sheets("MVTS").Cells(derlig_mvts + 1, 4).Value = Sheets("PMB").Cells(k, 4).Value
        Sheets("MVTS").Cells(derlig_mvts + 1, 5).Value = Sheets("PMB").Cells(k, 12).Value
        Sheets("MVTS").Cells(derlig_mvts + 1, 6).Value = Sheets("PMB").Cells(k, 13).Value
        Sheets("MVTS").Cells(derlig_mvts + 1, 7).Value = Sheets("PMB").Cells(k, 14).Value

        derlig_mvts = derlig_mvts + 1

    Next k

End Sub

bonsoir,

Une macro qui va te faire "aux petits oignons" :

Option Explicit
Dim ArrC, ArrS, Prod$, Ref$
Private Sub MAJ_MVTS_STOCK_Click()
Dim i&, k&
Dim ArrT(1 To 7)
ArrC = Feuil1.[A1].CurrentRegion.Value
k = UBound(ArrC)
ArrS = Feuil2.[A1].CurrentRegion.Value
   For i = 2 To UBound(ArrS) - 1
   Prod = ArrS(i, 3): Ref = ArrS(i, 12)
   If Not YExistProd Then
   k = k + 1
   ArrT(1) = "C1"
   ArrT(2) = Date
   ArrT(3) = ArrS(i, 3)
   ArrT(4) = ArrS(i, 4)
   ArrT(5) = ArrS(i, 12)
   ArrT(6) = ArrS(i, 13)
   ArrT(7) = ArrS(i, 4)
   Feuil1.Range("A" & k).Resize(1, 7) = ArrT
   End If
   Next
End Sub
Private Function YExistProd() As Boolean
Dim i&
   For i = 1 To UBound(ArrC)
      If ArrC(i, 3) = Prod And ArrC(i, 5) = Ref Then
      YExistProd = True
      Exit For
      End If
   Next
End Function

A+

Bonjour

Bonjour à tous

Une variante.

Bye !

Bonsoir Osaka, galopin01, le forum,

@galopin01 : sympa la petite fonction "YExistProd",

Attention, petit oubli ici:

ArrT(7) = ArrS(i, 4)

Ne serait-ce pas plutôt:

ArrT(7) = ArrS(i, 14)

Merci pour le code,

[EDIT] : bonsoir gmb merci également pour cette variante,

Amitiés,

Oui affirmatif pour 14... J'ai fait ça un peu à la dernière minute : C'est des erreurs de copier/coller en rafale...

A+

Merci à vous 3 pour vos réponses rapides et efficaces

Rebonjour gmb,

Partant du même principe, serait-il possible d'adapter ta proposition au fichier suivant :

Copier tous les nouveaux produits de la feuille MVTS vers la feuille ETAT_STOCK mais également leur description, unité et prix unitaire.

Attention, il peut y avoir des doublons dans la feuille MVTS (ce qui est normal) mais pas dans la feuille ETAT_STOCK (car celle-ci une synthèse de tous les mouvements effectués…un peu à l’image d’un TCD).

Etant novice dans l’utilisation des tableaux et array, pourrais-tu si possible détailler ton code ?

Je t’en remercie d’avance 😊

... ou si quelqu'un d'autre à code à proposer