Fonction RechercheV dans Macro

Bonjour,

J'ai besoin d'aide pour retoucher une macro qui marche "presque" bien

Elle va chercher des informations dans 3 fichiers différents pour les regrouper dans un 4Ieme sur 2 feuilles différentes

Mon problème est que la macro ne me donne pas la bonne localisation en fonction du code du produit

Voici la macro en question

Sub MacroInvCyclique2017()

Nom_Fichier = Application.GetOpenFilename("temp loc (*.xlsx), *.xlsx")
If Nom_Fichier <> False Then
    Workbooks.Open Filename:=Nom_Fichier
Nom_Fichier2 = Application.GetOpenFilename("temp loc (*.xlsx), *.xlsx")
End If
If Nom_Fichier2 <> False Then
    Workbooks.Open Filename:=Nom_Fichier2
Nom_Fichier3 = Application.GetOpenFilename("temp loc (*.xlsx), *.xlsx")
End If
If Nom_Fichier3 <> False Then
    Workbooks.Open Filename:=Nom_Fichier3

End If

    Set wsc = ThisWorkbook.Sheets("feuil1")    ' feuille cumul
   Set wsc1 = ThisWorkbook.Sheets("feuil2")    ' feuille cumul pour  produit sans lot
   k1 = 1    ' compteur de ligne sur wsc1
   dlc = wsc.Cells(Rows.Count, 1).End(xlUp).Row    ' nombre de lignes produit
   Set wsloc = Workbooks("Location Fidelio.xlsx").Sheets("Sheet1")    ' feuille localisation
   dlloc = wsloc.Cells(Rows.Count, 1).End(xlUp).Row    'nombre de lignes localisation
   Set rloc = wsloc.Range("A1:A" & dlloc)    'plage de recherche du produit sur localisation
   Set wslot = Workbooks("Inv avec lot Fidelio.xlsx").Sheets("Sheet1")    ' feuille lot
   dllot = wslot.Cells(Rows.Count, 1).End(xlUp).Row    'nombre de lignes lot
   Set rlot = wslot.Range("A1:A" & dllot)    'plage de recherche du produit sur lot
' on trie le cumul par numéro de produit
   wsc.Range("A1:A" & dlc).Sort key1:=wsc.Range("A1"), order1:=xlAscending, Header:=xlYes
    Set wssslot = Workbooks("Inv Fidelio.xlsx").Sheets("Sheet1")    'feuille sans lot
   dlsslot = wssslot.Cells(Rows.Count, 1).End(xlUp).Row    'nombre lignes sur sans lot
   Set rsslot = wssslot.Range("A1:A" & dlsslot)   'plage de recherche sans lot
   With wslot    '
       'on trie le lot par numéro de produit
       .Range("A1:D" & dllot).Sort key1:=.Range("A1"), order1:=xlAscending, Header:=xlYes
        wsc.Range("b2:F1000").ClearContents
        wsc1.Range("A2:f1000").ClearContents
        i = 2    ' pointeur de ligne sur cumul
       While wsc.Cells(i, 1) <> ""    ' tant quil y a un numéro de produit
           ' on recherche le produit dans lot
           Set re = rlot.Find(wsc.Cells(i, 1), lookat:=xlWhole, after:=rlot.Cells(1, 1))
            If Not re Is Nothing Then    'si trouvé
               k = re.Row    'k numéro de ligne du produit dans lot
               wsc.Cells(i, 1) = .Cells(k, 1)    ' on met le numéro de produit du lot
               wsc.Cells(i, 2) = .Cells(k, 2)    ' on met la description du lot
               ' on recherche le produit dans location
               Set re = rloc.Find(.Cells(i, 1), lookat:=xlWhole)
                If Not re Is Nothing Then    'si trouvé
                   wsc.Cells(i, 6) = re.Offset(0, 5)    'on met la zone de la location
               End If

                wsc.Cells(i, 3) = .Cells(k, 13)    ' on met n° de lot
               wsc.Cells(i, 4) = .Cells(k, 15)    'on met quantité
               k = k + 1    'on prend la ligne suivante du lot
               While .Cells(k, 1) = .Cells(k - 1, 1)    ' on parcourt tous les lots d'un même produit
                   i = i + 1    'on incrémente compteur de ligne
                   wsc.Rows(i).Insert shift:=xlDown    'on insère une ligne
                   wsc.Cells(i, 3) = .Cells(k, 13)    'on met le n° de lot
                   wsc.Cells(i, 4) = .Cells(k, 15)    'on met quantité
                   k = k + 1    'on prend la ligne suivante du lot
               Wend
                i = i + 1    'on prend le produit suivant sur cumul
           Else    'on n'a pas trouvé le produit sur lot on recherche sur sans lot
               Set re = rsslot.Find(wsc.Cells(i, 1), lookat:=xlWhole)
               wsc.Cells(i, 6) = "A vérifier"
               wsc.Cells(i, 4) = " Regarder sur Fidelio"
                If Not re Is Nothing Then    ' on a trouvé le produit sur sans lot
                   k = re.Row 'n° de ligne du produit
                   k1 = k1 + 1 'pointeur de ligne sur cumul sans lot
                   wsc1.Cells(k1, 1) = wsc.Cells(i, 1)    ' on copie le numéro de produit
                   wsc1.Cells(k1, 3) = re.Offset(0, 10) ' on copie la colonne K
                   ' on recherchele produit sur localisation
                   Set ra = rloc.Find(wsc.Cells(i, 1), lookat:=xlWhole)
                    If Not ra Is Nothing Then    'si trouvé
                       wsc1.Cells(k1, 2) = ra.Offset(0, 1)    'on copie description de location
                       If IsEmpty(ra.Offset(0, 5)) Then wsc1.Cells(k1, 5) = "A vérifier" Else wsc1.Cells(k1, 5) = ra.Offset(0, 5) 'on copie quantité de description

                    Else

                        wsc1.Cells(k1, 2) = re.Offset(0, 3)    'on copie quantité de description
                        wsc1.Cells(k1, 3) = re.Offset(0, 10) ' on copie la colonne K
                        MsgBox "Localisation non trouvée pour le produit " & wsc.Cells(i, 1)
                        If IsEmpty(ra.Offset(0, 5)) Then wsc1.Cells(k1, 5) = "A vérifier" Else wsc1.Cells(k1, 5) = ra.Offset(0, 5)   'on copie quantité de description

                    End If

                    wsc.Rows(i).Delete shift:=xlUp ' on supprime la ligne de cumul
               Else

                    Set ra = rloc.Find(wsc.Cells(i, 1), lookat:=xlWhole)

                    i = i + 1
                End If
            End If
        Wend
    End With

Workbooks("Location Fidelio.xlsx").Close False
Workbooks("Inv avec lot Fidelio.xlsx").Close False
Workbooks("Inv Fidelio.xlsx").Close False

End Sub

Ci-joint les 3 fichiers qu,il faut ouvrir au début de la macro et le fichier comprenant la macro

Merci beaucoup !!

Vincent

8inv-fidelio.xlsx (7.84 Ko)
13fichier-macro.xlsm (33.46 Ko)
Rechercher des sujets similaires à "fonction recherchev macro"