Automatisation extraction + recompilation de données
V
Bonjour tout le monde,
Je cherche le moyen de récupérer des données de 2 fichiers différents (lot et location) et de les recompiler dans un autre (cumul) "au propre" en fonction du code produit (Colonne A).
Le principal soucis que je rencontre est que les produits ont plusieurs n° de lot correspondants. J'ai tout d'abord pensé a une fonction RechercheV mais il faudrait y ajouter une fonction qui décalerai en fonction du nombre de lots par produit. Cela dépasse mes compétences en excel de loin et je n'ai pas trouvé de solution en fouillant dans le forum.
Pourriez-vous y jeter un coup d’œil ?
Merci d'avance
Vincent
bonjour,
une solution via une macro
Sub aargh()
Set wsc = ThisWorkbook.Sheets("feuil1")
Set wsloc = Workbooks("test location.xlsx").Sheets("feuil1")
dlloc = wsloc.Cells(Rows.Count, 1).End(xlUp).Row
Set rloc = wsloc.Range("A1:A" & dlloc)
Set wslot = Workbooks("test lot.xlsx").Sheets("feuil1")
dllot = wslot.Cells(Rows.Count, 1).End(xlUp).Row
With wslot
.Range("A1:D" & dllot).Sort key1:=.Range("A1"), order1:=xlAscending, Header:=xlYes
wsc.Range("A2:F1000").ClearContents
k = 1
oldpn = ""
For i = 2 To dllot
k = k + 1
If .Cells(i, 1) <> oldpn Then
wsc.Cells(k, 1) = .Cells(i, 1)
wsc.Cells(k, 2) = .Cells(i, 2)
Set re = rloc.Find(.Cells(i, 1), lookat:=xlWhole)
If Not re Is Nothing Then
wsc.Cells(k, 4) = re.Offset(0, 5)
End If
oldpn = .Cells(i, 1)
End If
wsc.Cells(k, 3) = .Cells(i, 3)
wsc.Cells(k, 5) = .Cells(i, 4)
Next i
End With
End SubV
Salut h2so4,
J'ai essayé la macro qui fonctionne très bien !!!!
J'aimerais juste que celle-ci ne recopie pas les infos dans une nouvelle feuille mais qu'elle puisse compléter le nom, le lot et la qte en fonction des codes produits de la feuille cumul. (un peu comme un rechercheV en fct des codes). Tu penses que cela est codable ?
Merci d'avoir pris le temps de faire cela ! Et désolé de ne pas avoir été clair des le début.
Vincent
bonjour,
macro adaptée
Sub aargh()
Set wsc = ThisWorkbook.Sheets("feuil1")
dlc = wsc.Cells(Rows.Count, 1).End(xlUp).Row
Set wsloc = Workbooks("test location.xlsx").Sheets("feuil1")
dlloc = wsloc.Cells(Rows.Count, 1).End(xlUp).Row
Set rloc = wsloc.Range("A1:A" & dlloc)
Set wslot = Workbooks("test lot.xlsx").Sheets("feuil1")
dllot = wslot.Cells(Rows.Count, 1).End(xlUp).Row
Set rlot = wslot.Range("A1:A" & dllot)
wsc.Range("A1:A" & dlc).Sort key1:=wsc.Range("A1"), order1:=xlAscending, Header:=xlYes
With wslot
.Range("A1:D" & dllot).Sort key1:=.Range("A1"), order1:=xlAscending, Header:=xlYes
wsc.Range("b2:F1000").ClearContents
i = 2
While wsc.Cells(i, 1) <> ""
Set re = rlot.Find(wsc.Cells(i, 1), lookat:=xlWhole, after:=rlot.Cells(1, 1))
If Not re Is Nothing Then
k = re.Row
wsc.Cells(i, 1) = .Cells(k, 1)
wsc.Cells(i, 2) = .Cells(k, 2)
Set re = rloc.Find(.Cells(i, 1), lookat:=xlWhole)
If Not re Is Nothing Then
wsc.Cells(i, 4) = re.Offset(0, 5)
End If
wsc.Cells(i, 3) = .Cells(k, 3)
wsc.Cells(i, 5) = .Cells(k, 4)
k = k + 1
While .Cells(k, 1) = .Cells(k - 1, 1)
i = i + 1
wsc.Rows(i).Insert shift:=xlDown
wsc.Cells(i, 3) = .Cells(k, 3)
wsc.Cells(i, 5) = .Cells(k, 4)
k = k + 1
Wend
End If
i = i + 1
Wend
End With
End SubV
wHOUU!!!!
Merci beaucoup c'est exactement ca !!
Vincent
Est-il possible d'afficher un message si le code est inconnu ?
re-bonjour,
code avec le msg "code non trouvé"
Sub aargh()
Set wsc = ThisWorkbook.Sheets("feuil1")
dlc = wsc.Cells(Rows.Count, 1).End(xlUp).Row
Set wsloc = Workbooks("test location.xlsx").Sheets("feuil1")
dlloc = wsloc.Cells(Rows.Count, 1).End(xlUp).Row
Set rloc = wsloc.Range("A1:A" & dlloc)
Set wslot = Workbooks("test lot.xlsx").Sheets("feuil1")
dllot = wslot.Cells(Rows.Count, 1).End(xlUp).Row
Set rlot = wslot.Range("A1:A" & dllot)
wsc.Range("A1:A" & dlc).Sort key1:=wsc.Range("A1"), order1:=xlAscending, Header:=xlYes
With wslot
.Range("A1:D" & dllot).Sort key1:=.Range("A1"), order1:=xlAscending, Header:=xlYes
wsc.Range("b2:F1000").ClearContents
i = 2
While wsc.Cells(i, 1) <> ""
Set re = rlot.Find(wsc.Cells(i, 1), lookat:=xlWhole, after:=rlot.Cells(1, 1))
If Not re Is Nothing Then
k = re.Row
wsc.Cells(i, 1) = .Cells(k, 1)
wsc.Cells(i, 2) = .Cells(k, 2)
Set re = rloc.Find(.Cells(i, 1), lookat:=xlWhole)
If Not re Is Nothing Then
wsc.Cells(i, 4) = re.Offset(0, 5)
End If
wsc.Cells(i, 3) = .Cells(k, 3)
wsc.Cells(i, 5) = .Cells(k, 4)
k = k + 1
While .Cells(k, 1) = .Cells(k - 1, 1)
i = i + 1
wsc.Rows(i).Insert shift:=xlDown
wsc.Cells(i, 3) = .Cells(k, 3)
wsc.Cells(i, 5) = .Cells(k, 4)
k = k + 1
Wend
Else
Msgbox "code " & .cells(k,1) & " non trouvé"
End If
i = i + 1
Wend
End With
End SubV
Re,
Merci c'est cool
J,essayais de mettre la ligne avant les boucles mais sans succès
La j'essaye d'appliquer ta macro sur une autre feuille sans numero de lot.
Pcq J,ai une feuille pour les produits avec numero de lot et une pour ceux sans numero de lot (+ celle de location)
Donc a mon tour de bosser un peu
Merci encore !
V
Re,
J'ai bougé un peu les colonnes au final en fouillant a tatons dans la macro, qu'en penses tu ? J'ai l'impression que la macro fonctionne toujours (^^)
Sub aargh()
Set wsc = ThisWorkbook.Sheets("feuil1")
dlc = wsc.Cells(Rows.Count, 1).End(xlUp).Row
Set wsloc = Workbooks("test location.xlsx").Sheets("feuil1")
dlloc = wsloc.Cells(Rows.Count, 1).End(xlUp).Row
Set rloc = wsloc.Range("A1:A" & dlloc)
Set wslot = Workbooks("test lot.xlsx").Sheets("feuil1")
dllot = wslot.Cells(Rows.Count, 1).End(xlUp).Row
Set rlot = wslot.Range("A1:A" & dllot)
wsc.Range("A1:A" & dlc).Sort key1:=wsc.Range("A1"), order1:=xlAscending, Header:=xlYes
With wslot
.Range("A1:D" & dllot).Sort key1:=.Range("A1"), order1:=xlAscending, Header:=xlYes
wsc.Range("b2:F1000").ClearContents
i = 2
While wsc.Cells(i, 1) <> ""
Set re = rlot.Find(wsc.Cells(i, 1), lookat:=xlWhole, after:=rlot.Cells(1, 1))
If Not re Is Nothing Then
k = re.Row
wsc.Cells(i, 1) = .Cells(k, 1)
wsc.Cells(i, 2) = .Cells(k, 2)
Set re = rloc.Find(.Cells(i, 1), lookat:=xlWhole)
If Not re Is Nothing Then
wsc.Cells(i, 6) = re.Offset(0, 5)
End If
wsc.Cells(i, 3) = .Cells(k, 3)
wsc.Cells(i, 4) = .Cells(k, 4)
k = k + 1
While .Cells(k, 1) = .Cells(k - 1, 1)
i = i + 1
wsc.Rows(i).Insert shift:=xlDown
wsc.Cells(i, 3) = .Cells(k, 3)
wsc.Cells(i, 4) = .Cells(k, 4)
k = k + 1
Wend
End If
i = i + 1
Wend
End With
End SubPar contre le message d'erreur j,ai laissé de côté.... ça bloquait excel a la fin des messages et ca s'affichait pas sur les bons produits
Et j'ai (encore) un soucis, je n'arrive pas a adapter la macro sur mon autre feuille, la localisation ne s'affiche pas du tout....
Le but ultime étant bien entendu de lancer les 2 macros sur le même fichier, j'ai essayé de retirer le .clear et le .sort et le .order pour laisser les code en place apres la macro 1 "aargh" et faire la macro 2 pour les produits sans lot mais sans succès
Merci
Vincent
bonsoir,
si j'ai bien compris ce que tu cherches à faire
Sub aargh()
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("test location.xlsx").Sheets("feuil1") ' 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("test lot.xlsx").Sheets("feuil1") ' 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
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
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, 4) = re.Offset(0, 5) 'on met la zone de la location
End If
wsc.Cells(i, 3) = .Cells(k, 3) ' on met n° de lot
wsc.Cells(i, 5) = .Cells(k, 4) '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, 3) 'on met le n° de lot
wsc.Cells(i, 5) = .Cells(k, 4) '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
k1 = k1 + 1 ' on incrémente le compteur de produit non trouvé
wsc1.Cells(k1, 1) = wsc.Cells(i, 1) ' on copie le numéro de produit
' on recherchele produit sur localisation
Set re = rloc.Find(wsc.Cells(i, 1), lookat:=xlWhole)
If Not re Is Nothing Then 'si trouvé
wsc1.Cells(k1, 2) = re.Offset(0, 1) 'on copie description de location
wsc1.Cells(k1, 4) = re.Offset(0, 5) 'on copie zone
Else
MsgBox "lot et localisation non trouvés pour le produit " & wsc.Cells(i, 1)
End If
wsc.Rows(i).Delete shift:=xlUp 'on supprime la ligne du produit non trouvé dans lot du cumul
End If
Wend
End With
End SubV
Yes c'est ca !
J'essaye d'intervertir qql ligne et de rajouter les qte sur la feuil2 de cumul (ligne K de test sans lot) mais je devrais pouvoir y arriver avec tes explications
Merci beaucoup
Vicnent
V
Tu peux regarder ca stp ?
Merci
Sub Aarf()
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("test location.xlsx").Sheets("feuil1") ' 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("test lot.xlsx").Sheets("feuil1") ' 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
Set wssslot = Workbooks("test sans lot.xlsx.").Sheets("feuil1") 'feuille sans lot
dlsslot = wssslot.Cells(Rows.Count, 1).End(x1Up).Row 'nombre lignes sur sans lot
Set rsslot = wssslot.Range("A1:A" & dlsslot) 'plage de recherche sans lot
' on trie le cumul par numéro de produit
wsc.Range("A1:A" & dlc).Sort key1:=wsc.Range("A1"), order1:=xlAscending, Header:=xlYes
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
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, 3) ' on met n° de lot
wsc.Cells(i, 4) = .Cells(k, 4) '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, 3) 'on met le n° de lot
wsc.Cells(i, 4) = .Cells(k, 4) '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
k1 = k1 + 1 ' on incrémente le compteur de produit non trouvé
wsc1.Cells(k1, 1) = wsc.Cells(i, 1) ' on copie le numéro de produit
' on recherchele produit sur localisation
Set re = rloc.Find(wsc.Cells(i, 1), lookat:=xlWhole)
Set re2 = rsslot.Find(wsc.Cells(i, 1), lookat:=x1Whole)
If Not re Is Nothing Then 'si trouvé
wsc1.Cells(k1, 2) = re.Offset(0, 1) 'on copie description de location
wsc1.Cells(k1, 6) = re.Offset(0, 5) 'on copie zone
Else
If re2 Is Nothing Then
wsc1.Cells(k1, 4) = re2.Offset(0, 11)
Else
MsgBox "lot et localisation non trouvés pour le produit " & wsc.Cells(i, 1)
End If
wsc.Rows(i).Delete shift:=xlUp 'on supprime la ligne du produit non trouvé dans lot du cumul
End If
Wend
End With
End Subtu peux mettre un fichier exemple "sans lot" ?
V
bonjour,
modification non testée,
Sub aargh()
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("test location.xlsx").Sheets("feuil1") ' 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("test lot.xlsx").Sheets("feuil1") ' 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("test sans lot.xlsx.").Sheets("feuil1") 'feuille sans lot
dlsslot = wssslot.Cells(Rows.Count, 1).End(x1Up).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
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, 4) = re.Offset(0, 5) 'on met la zone de la location
End If
wsc.Cells(i, 3) = .Cells(k, 3) ' on met n° de lot
wsc.Cells(i, 5) = .Cells(k, 4) '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, 3) 'on met le n° de lot
wsc.Cells(i, 5) = .Cells(k, 4) '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:=x1Whole)
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(k, 1) ' on copie le numéro de produit
wsc1.Cells(k1, 4) = re.Offset(0, 11) ' on copie la colonne K
' on recherchele produit sur localisation
Set re = rloc.Find(.Cells(i, 1), lookat:=xlWhole)
If Not re Is Nothing Then 'si trouvé
wsc1.Cells(k1, 2) = re.Offset(0, 2) 'on copie description de location
wsc1.Cells(k1, 5) = re.Offset(0, 5) 'on copie quantité de description
Else
MsgBox "localisation non trouvée pour le produit sans lot " & wsc.Cells(i, 1)
End If
wsc.Rows(i).Delete shift:=xlUp ' on supprime la ligne de cumul
Else
MsgBox "produit non trouvé dans fichier sans lot" & wsc.Cells(i, 1)
End If
End If
Wend
End With
End SubV
Re,
Apres avoir corriger qql 1 en l dans mes anciennes formules, la macro se lance mais le msgBox reste bloqué et qd j'essaye de retirer le msgBox celle_ci se bloque qd même.
Bonne soirée
bonjour,
une correction
Sub aargh()
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("test location.xlsx").Sheets("feuil1") ' 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("test lot.xlsx").Sheets("feuil1") ' 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("test sans lot.xlsx").Sheets("feuil1") '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, 4) = re.Offset(0, 5) 'on met la zone de la location
End If
wsc.Cells(i, 3) = .Cells(k, 3) ' on met n° de lot
wsc.Cells(i, 5) = .Cells(k, 4) '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, 3) 'on met le n° de lot
wsc.Cells(i, 5) = .Cells(k, 4) '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)
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, 5) = re.Offset(0, 10) ' on copie la colonne K
' on recherchele produit sur localisation
Set re = rloc.Find(.Cells(i, 1), lookat:=xlWhole)
If Not re Is Nothing Then 'si trouvé
wsc1.Cells(k1, 2) = re.Offset(0, 2) 'on copie description de location
wsc1.Cells(k1, 5) = re.Offset(0, 5) 'on copie quantité de description
Else
MsgBox "localisation non trouvée pour le produit sans lot " & wsc.Cells(i, 1)
End If
wsc.Rows(i).Delete shift:=xlUp ' on supprime la ligne de cumul
Else
MsgBox "produit non trouvé dans fichier sans lot" & wsc.Cells(i, 1)
i = i + 1
End If
End If
Wend
End With
End SubV
salut,
Merci pour ton aide !!!
Je met ici la macro que j'utilise au final
Sub aargh()
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("test location.xlsx").Sheets("feuil1") ' 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("test lot.xlsx").Sheets("feuil1") ' 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("test sans lot.xlsx").Sheets("feuil1") '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, 3) ' on met n° de lot
wsc.Cells(i, 4) = .Cells(k, 4) '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, 3) 'on met le n° de lot
wsc.Cells(i, 4) = .Cells(k, 4) '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)
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
wsc1.Cells(k1, 5) = ra.Offset(0, 5) 'on copie quantité de description
Else
MsgBox "localisation non trouvée pour le produit sans lot " & wsc.Cells(i, 1)
End If
wsc.Rows(i).Delete shift:=xlUp ' on supprime la ligne de cumul
Else
MsgBox "produit non trouvé dans fichier sans lot " & wsc.Cells(i, 1)
i = i + 1
End If
End If
Wend
End With
End SubV
salut,
J,essaye de rajouter si pas de localisation alors "a vérifier"
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