Copie de cellules suivant critères

**Osaka2017** · 10/04/2021, 19h39

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

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
 
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

Invité · 11/04/2021, 12h29

Envoyé par Osaka2017

Bonjour,

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

Ce cas ne peut être traité car vous avez des doublons dans les produits ou bien votre règle de gestion est mal décrite. Ce qui peut être fait, c'est la comparaison des couples Produit - N° de réception et modifier les éléments dans MVTS si une nouvelle date ou autre information survient pour ce couple dans PMB.

**Osaka2017** · 11/04/2021, 13h29

Envoyé par Eric KERGRESSE

Bonjour,

Ce cas ne peut être traité car vous avez des doublons dans les produits ou bien votre règle de gestion est mal décrite. Ce qui peut être fait, c'est la comparaison des couples Produit - N° de réception et modifier les éléments dans MVTS si une nouvelle date ou autre information survient pour ce couple dans PMB.

Bonjour,

Merci pour votre retour.

Effectivement, on doit comparer le produit ET son numéro de réception.
On peut donc réceptionner plusieurs fois le même produit mais avec des numéros de réception différents.

Exemples:

D612301000309 et 31700915 -> OK
D612301000309 et 31700910 -> OK
D612301000310 et 31700915 -> OK

Invité · 11/04/2021, 15h58

Envoyé par Osaka2017

Il n'y a donc que la quantité qui peut changer si existant.

Dans un module standard :

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
63
64
65
66
67
68
69
70
71
72
73
74
75
76
 
Sub Maj_Mouvements_Stock()
 
Dim I As Integer, J As Integer, DerLig_Mvts As Integer, DerLig_Pmb As Integer, TitreMvts As Integer, TitrePmb As Integer
Dim dt_jour As Date
Dim Plage_Mvts As Range, Plage_Entrees As Range
Dim Continuer As Boolean
Dim HeureDebut, HeureFin, TempsTotal
 
    HeureDebut = Timer
 
    With Application
         .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With
 
    dt_jour = Format(Now(), "dd-mm-yyyy")
 
    With Sheets("MVTS")
         TitreMvts = 11
         DerLig_Mvts = .Cells(.Rows.Count, "C").End(xlUp).Row
         Set Plage_Mvts = .Range(.Cells(TitreMvts, "C"), .Cells(DerLig_Mvts, "C"))
         Plage_Mvts.Offset(0, 14 - 3).Interior.ColorIndex = xlNone
         DerLig_Mvts = DerLig_Mvts + 1
    End With
 
    With Sheets("PMB")
         TitrePmb = 11
         DerLig_Pmb = .Cells(.Rows.Count, "C").End(xlUp).Row
         Set Plage_Entrees = .Range(.Cells(TitrePmb, "C"), .Cells(DerLig_Pmb, "C"))
    End With
 
 
    For J = 1 To Plage_Entrees.Count
 
        Continuer = True
        For I = 1 To Plage_Mvts.Count
            If Plage_Mvts(I) & Plage_Mvts(I).Offset(0, 2) = Plage_Entrees(J) & Plage_Entrees(J).Offset(0, 9) Then
               Continuer = False
               Plage_Mvts(I).Offset(0, 2) = Plage_Entrees(J).Offset(0, 12 - 3)
               Plage_Mvts(I).Offset(0, 3) = Plage_Entrees(J).Offset(0, 13 - 3)
               With Plage_Mvts(I).Offset(0, 4)
                    .Value = Plage_Entrees(J).Offset(0, 14 - 3)
                    .Interior.Color = RGB(255, 255, 0)  ' La quantité apparaît en jaune
               End With
            End If
        Next I
 
        If Continuer = True Then
           With Sheets("Mvts")
                .Cells(DerLig_Mvts, "A") = "C1"
                .Cells(DerLig_Mvts, "B") = dt_jour
                .Cells(DerLig_Mvts, "C") = Plage_Entrees(J)
                .Cells(DerLig_Mvts, "D").Value = Plage_Entrees(J).Offset(0, 4 - 3)  ' Description
                .Cells(DerLig_Mvts, "E") = Plage_Entrees(J).Offset(0, 12 - 3)       ' Réception
                .Cells(DerLig_Mvts, "F").Value = Plage_Entrees(J).Offset(0, 13 - 3) ' Unité
                .Cells(DerLig_Mvts, "G").Value = Plage_Entrees(J).Offset(0, 14 - 3) ' Nb pièces
 
                DerLig_Mvts = DerLig_Mvts + 1
           End With
        End If
 
    Next J
 
    With Application
         .ScreenUpdating = True
         .Calculation = xlCalculationAutomatic
    End With
 
    HeureFin = Timer
    TempsTotal = HeureFin - HeureDebut
    MsgBox "Temps total du traitement : " & Round(TempsTotal, 0) & " seconde(s)"
 
    Set Plage_Mvts = Nothing:   Set Plage_Entrees = Nothing
 
End Sub

Dans le module de l'onglet MVTS :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
Private Sub MAJ_MVTS_STOCK_Click()
 
        Maj_Mouvements_Stock
 
End Sub

**Osaka2017** · 13/04/2021, 15h09

Merci pour votre réponse ERIC.

Copie de cellules suivant critères

Macros et VBA Excel

Discussions similaires

Partager

Partager