Mouvement de stocks

Bonjour à tous,

Je me tourne vers dans le cadre de la rédaction du macro VBA.

Je vais tenter d'expliquer mon problème le plus clairement possible.

Je souhaite faire un ajout de stock en gérant cette entrée via le Fichier 2 (historique de tous les mouvements de stock pour cette référence) et on voit le mouvement de stock sur le Fichier 1.

Ci-dessous ma tentative de code:

Sub entrée_stock_MP()
'
' entrée_stock_MP Macro
'
Dim ligne As Integer: ligne = 2
Dim valeur_stock As Integer: valeur_stock = 0
Dim valeur_demandee As Integer: valeur_demandee = 0
Dim ref_cat As String: Dim ref_mp As String
Dim choix_utilisateur As Byte
Dim cellule As Range: Dim test As Boolean
test = False

While (Workbooks("Fichier1.xlsm").Worksheets("Matières premières").Cells(ligne, 3).Value <> "")
    valeur_stock = Workbooks("Fichier 1.xlsm").Worksheets("Matières premières").Cells(ligne, 3).Value
    ref_cat = Workbooks("Fichier 1.xlsm").Worksheets("Matières premières").Cells(ligne, 1).Value

ThisWorkbook.Worksheets("Mvt d'entrées").Cells ("B1")

        While (Workbooks("Fichier 1.xlsm").Worksheets("Matières premières").Cells(ligne, 3).Value <> "")
            If (cellule.Value = Workbooks("Fichier 1.xlsm").Worksheets("Matières premières").Cells(ligne, 1).Value) Then

            Workbooks("Fichier 1.xlsm").Worksheets("Matières premières").Cells(ligne, 3).Value = Workbooks("APPLICATION AROMES ET SAVEURS.xlsm").Worksheets("Matières premières").Cells(ligne, 3).Value + ThisWorkbook.Worksheets("Mvt d'entrées").Cells("K7").Value
            End If
        Wend

        Exit Sub
Wend

End Sub

Il y a en amont de cette partie de la macro un copier/coller automatisé qui fonctionne et que je n'ai pas reporté ici.

Dans l'espoir que vous pourrez éclairer ma lanterne.

Par avance merci

Flo

Bonjour et bienvenue floflo45,

Voici un code à essayer:

Sub test()
Dim ws As Worksheet, ws1 As Workbook
Dim t()

    Set ws = ThisWorkbook.Sheets("Matières premières")
    Set ws1 = Application.Workbooks.Open(Filename:="C:\Users\*******Downloads\Fichier 2.xlsx")
    t = ws.Range("A1").CurrentRegion

    For i = LBound(t, 1) + 1 To UBound(t, 1)
        If t(i, 1) = ws1.Sheets("Mvt d'entrées").Range("B1") And t(i, 2) = ws1.Sheets("Mvt d'entrées").Range("B2") Then
            ws.Cells(i + 1, 3) = ws.Cells(i + 1, 3) + ws1.Sheets("Mvt d'entrées").Range("K7")
        End If
    Next i

    ws1.Close
    ws=Nothing : ws1=Nothing

End Sub

Bonjour Florian 53,

Merci pour ta réponse.

Mais j'ai un peu de mal à comprendre le fonctionnement de ta macro.

J'ai l'impression que l'ouverture du Fichier 2 est géré par le Fichier 1...?

A savoir que le Fichier 2 sera déjà ouvert. J'entre les données dans le cadre prévu pour, sur la droite de ma feuille.

Les données sont copiées collées dans mon historique sur le Fichier 2 et le stock est ajouté sur le Fichier 1.

Je ne sais pas si je suis clair dans mon explication :S

Flo

Bonjour floflo45,

Oui effectivement l'ouverture du "Fichier2" est inclus dans la macro du 'Fichier1", si celui est déjà ouvert tu peux changer le code comme ci-dessous:

Sub test()
Dim ws As Worksheet, ws1 As Workbook
Dim t()

    Set ws = ThisWorkbook.Sheets("Matières premières")
    Set ws1 = Workbooks("Fichier 2.xlsx")
    If not ws1=nothing then
        t = ws.Range("A1").CurrentRegion

        For i = LBound(t, 1) + 1 To UBound(t, 1)
            If t(i, 1) = ws1.Sheets("Mvt d'entrées").Range("B1") And t(i, 2) = ws1.Sheets("Mvt d'entrées").Range("B2") Then
                ws.Cells(i + 1, 3) = ws.Cells(i + 1, 3) + ws1.Sheets("Mvt d'entrées").Range("K7")
            End If
        Next i
    Else msgbox " Le Fichier 2 n'est pas ouvert, veuillez l'ouvrir"
    End if 

    ws1.Close
    ws=Nothing : ws1=Nothing

End Sub

Bonsoir Florian53,

J'ai essayé la macro en la réadaptant dans le sens où elle part du Fichier 2 et non du Fichier 1comme tu l'as rédigée. Mes explications ne devaient pas être claires, désolé.

Quoiqu'il en soit j'ai un message d'erreur qui apparait: "Utilisation incorrecte de l'objet - (Module 4 37:17)". Et quand je retourne dans la rédaction de la macro il me surligne le premier "Nothing".

Je te mets en dessous ma version de rédaction de macro:

Dim Ws As Worksheet, wsl As Workbook
Dim t()

    Set Ws = ThisWorkbook.Sheets("Mvt d'entrées")
    Set wsl = Workbooks("Fichier1.xlsm")
    If Not wsl = Nothing Then
        t = wsl.Range("A1").CurrentRegion

        For i = Lboundt(t, 1) + 1 To UBound(t, 1)
            If t(i, 1) = Ws.Sheets("Mvt d'entrées").Range("B1") And t(i, 2) = Ws.Sheets("Mvt d'entrées").Range("B2") Then
            wsl.Cells(i + 1, 8) = wsl.Cells(i + 1, 8) + Ws.Sheets("Mvt d'entrées").Range("K7")
            End If
        Next i
    Ws = Nothing: wsl = Nothing

End Sub

En espérant que tu pourras m'aider à résoudre mon problème.

Par avance merci.

Floflo45

Bonjour floflo45,

Est ce que ton fichier "Fichier1.xlsm" est bien ouvert pendant l’exécution de la macro ? Est ce que celui porte bien le même nom? même extension ?

Bonjour Florian53,

Tout d'abord merci pour ta patience!

En effet mes deux fichiers sont ouverts lors de l'exécution de la macro. Les deux fichiers ont la même extension ".xlsm".

Mon fichier ne s'appelle pas Fichier 1 mais j'ai adapté le nom dans ma macro.

Dans l'attente de te lire.

Floflo45

Le fichier qui contient la macro, n'est pas le fichier "Fichier1.xlsm" ? La macro doit se situer dans le fichier ou l'on visualise les mouvements de Stock .

C’est exact, la macro se situe dans le « Fichier 2.xlsm » le fichier où il y a toutes les entrées de stock

Peux tu transmettes tes 2 fichiers en enlevant les informations confidentielles ?

Je t’envoie ça ce soir 👍🏼

Bonsoir,

Désolé pour la réponse tardive.

En pièce jointe les deux fichiers "Appli.xlsm" (=Fichier 1) base de données des matières premières et "Model MP.xlsm" (=Fichier 2) fiche article d'une matière première.

- Sur la fiche article:

Je rentre mes données dans le tableau de droite et je clique sur le "bouton 1"

Les données se copient/collent dans le tableau de gauche en incrémentant le tableau à chaque fois (mais ça je gère je sais faire)

-Sur la base de donnée:

La valeur de stock rentrée sur la fiche produit est ajoutée à la valeur de stock déjà existant dans la base de données

Il y a une recherche par référence de matière première.

Le code matière première est présent dans la colonne A de la base de données. Et retrouvé sur la fiche article en cellule B2.

En espérant être plus clair avec ces deux fichiers.

Par avance merci.

Bonne soirée!

Bonjour floflo45,

De ce que je vois dans ton code c'est que tu utilise des accents un peu partout même dans les noms de Modules, tous les accents peut importe ou est ce qu'ils sont utilisés sont à proscrire.

Je vois que le Set de "ws1" n'est affecté au bon classeur, il devrait être affecté à "Appli.xlsm"

Set wsl = Workbooks("APPLICATION AROMES ET SAVEURS.xlsm")

Il y a aussi des parties de code que je comprends pas, encore une histoire d'accents:

Sheets("Mvt d'entrŽes").Select

Il te faut modifier entièrement ton code pour enlever toutes utilisations des accents et indenter ton code pour une meilleur compréhension pour toi mais aussi pour ceux qui essaye de comprendre derrière toi.

Sub entrŽe_stock_MP()
'
' entrŽe_stock_MP Macro
'

Sheets("Mvt d'entrŽes").Select
Range("I7:N7").Select
Selection.Copy
Dim Derligne As Integer
Derligne = Range("A1048576").End(xlUp).Row
Range("A1").Offset(Derligne).Select
 Selection.PasteSpecial Paste:=xlValues, operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Application.CutCopyMode = False

Range("J7:L7").Select
Selection.Copy
Sheets("controles").Select
Derligne = Range("B1048576").End(xlUp).Row
Range("B1").Offset(Derligne).Select
Selection.PasteSpecial Paste:=xlValues, operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Application.CutCopyMode = False

Sheets("Mvt d'entrŽes").Select
Range("N7").Select
Selection.Copy
Sheets("controles").Select
Range("E6").End(xlDown).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlValues, operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Application.CutCopyMode = False

Sheets("Mvt d'entrŽes").Select

Dim Ws As Worksheet, wsl As Workbook
Dim t()

    Set Ws = ThisWorkbook.Sheets("Mvt d'entrŽes")
    Set wsl = Workbooks("APPLICATION AROMES ET SAVEURS.xlsm")
    If Not wsl = Nothing Then
        t = wsl.Range("A1").CurrentRegion

        For i = Lboundt(t, 1) + 1 To UBound(t, 1)
            If t(i, 1) = Ws.Sheets("Mvt d'entrŽes").Range("B1") And t(i, 2) = Ws.Sheets("Mvt d'entrŽes").Range("B2") Then
            wsl.Cells(i + 1, 8) = wsl.Cells(i + 1, 8) + Ws.Sheets("Mvt d'entrŽes").Range("K7")
            End If
        Next i
    Ws = Nothing: wsl = Nothing

End Sub

Bonjour Florian,

J'ai retiré tous les accents et essayé d'éclaircir ma démarche sur la macro en mettant en vert l'objectif de chaque partie de la macro.

Je te remets les fichiers en pièce jointe.

J'aurais besoin de ton aide sur la parie ajout de stock.

Par avance merci

Floflo45

Bonjour Florian53,

Je relance un peu le sujet, est-ce que tu aurais le temps de jeter un oeil aux modifications que j'ai apportées à la macro et me dire ce que je dois encore modifier.

Par avance merci

Flo