MACRO - Pré-remplir dossier d'expédition
Bonjour,
Je sollicite l'aide le forum qui m'avait déjà donnés de précieux conseil sur un autre problème.
La macro sur laquelle je travail à pour objectif d'optimiser ma préparation de dossier d'expédition pour le transport de colis.
Je dispose d'un classeur ("HISTO.xlsm") répertoriant l'ensemble des colis que je gère ainsi que les informations associées à chacun (Code à Barre/Producteur/Masse...).
Lorsqu'une expédition est planifiée, je renseigne dans mon "HISTO" la date de chargement définie (colonne I).
Ensuite, pour pouvoir enclencher l'expédition, je dois remplir un dossier d'expédition qui reprend certaines informations du fichier "HISTO".
Je vous joint un classeur condensé "TEST.xlsm" pour illustrer ce que je cherche à réaliser.
Je souhaiterais donc comprendre comment créer une macro / bouton permettant :
1 - D'ouvrir une boîte de dialogue demandant de saisir une date d'expédition
2 - De rechercher dans la feuille "HISTO" les lignes ayant cette date de renseignée en colonne I afin d'identifier les colis à expédier
3 - De retranscrire les infos : Code à Barre (colonne A) / Date d'arrivée (colonne H) / Masse (colonne K) dans les feuilles "Colis 1-10" et "Colis 11-20"
Petite subtilité, comme l'indique le nom des feuilles à remplir, mes expéditions sont limitées à 10 colis par conteneur, il faut donc que la macro retranscrive les informations relatives aux 10 premiers colis dans la feuille 1 "Colis 1-10" et les 10 suivants dans la feuille 2 "Colis 11-20"
J'ai déjà commencé à élaborer une macro (Cf fichier joint : Module2 - PREPA_EXPED) mais je bloque sur l'étape 2 (après avoir renseignée une date dans la boite de dialogue).
Si ce que je cherche à faire est possible, pourriez-vous m'orienter dans ma recherche d'une solution ?
Je vous remercie par avance du temps passé sur mon problème.
bonsjour,
une proposition
Sub PREPA_EXP()
'Pré remplir le fichier 5 onglets"
'VARIABLES :
Dim Ihi As Long, Ibd As Long
Dim HISTO As Workbook, EXP As Workbook 'Classeurs Excel
Dim HI As Worksheet, BD As Worksheet 'Feuilles Excel
Dim Cell As Range 'Plage de données
Dim DAT 'Type "Variant" par défaut
Set HISTO = ThisWorkbook
Set HI = HISTO.Worksheets("HISTO")
Set c1 = HISTO.Worksheets("Colis 1-10")
Set c2 = HISTO.Worksheets("Colis 11-20")
exped = "pas une date"
While Not IsDate(exped) 'tant que la date introduite n'a pas le bon format on demande la date
exped = Application.InputBox("ENTREZ LA DATE DE L'EXPEDITION A PREPARER :" & Chr(10) & Chr(10) & _
"(Format à respecter : jj/mm/aaaa)", "EXPEDITION TFA")
If exped = "" Then Exit Sub 'si date vide on arrête
Wend
DAT = CDate(exped)
colis = 0
Application.EnableEvents = False
Application.ScreenUpdating = False
Set wscolis = c1
For i = 3 To HI.Range("i" & Rows.Count).Row 'on parcourt toutes les lignesde HI
If HI.Cells(i, "I") = DAT Then 'si date trouvée
colis = colis + 1 'on incrémente nombre de colis
If colis = 11 Then Set wscolis = c2: colis = 1
If colis > 20 Then MsgBox "plus de 20 colis trouvés": Exit Sub
wscolis.Cells(8, colis + 2) = HI.Range("A" & i)
wscolis.Cells(10, colis + 2) = HI.Range("H" & i)
wscolis.Cells(11, colis + 2) = HI.Range("K" & i)
End If
Next i
Application.EnableEvents = True
If colis = 0 Then MsgBox "pas de colis trouvé pour le " & exped
End Sub
Bonjour h2so4,
Désolé pour le temps de réponse, en déplacement hier je n'ai pas pu étudier ta solution plus tôt...
Alors un grand merci à toi pour ta solution
Elle correspond parfaitement à mon besoin, j'ai donc pu l'analyser et l'adapter à mon fichier.
Ci-dessous le code final adapté :
Sub PREPA_EXP()
'Pré remplir le fichier 5 onglets"
'VARIABLES :
Dim Ihi As Long, Ibd As Long
Dim HISTO As Workbook, EXP As Workbook
'Classeurs Excel
Dim HI As Worksheet, BD As Worksheet, C1 As Worksheet, C2 As Worksheet, DT As Worksheet
'Feuilles Excel
Dim Cell As Range
'Plage de données
Dim DAT, Colis, CAB
'Type "Variant" par défaut
exped = "pas une date"
While Not IsDate(exped)
'Tant que le format de date n'est pas respecté, une date est demandée.
exped = Application.InputBox("ENTREZ LA DATE DE L'EXPEDITION A PREPARER :" & Chr(10) & Chr(10) & _
"(Format à respecter : jj/mm/aaaa)", "EXPEDITION TFA")
Set HISTO = ThisWorkbook
Set EXP = Workbooks.Open("Chemin d'accès + \PREPA_EXP.xlsm")
Set HI = HISTO.Worksheets("HISTO")
Set BD = HISTO.Worksheets("BD")
Set C1 = EXP.Worksheets("Colis 1-10")
Set C2 = EXP.Worksheets("Colis 11-20")
Set DT = EXP.Worksheets("Récapitulatif DT")
HI.Unprotect ("Mot de passe")
BD.Unprotect ("Mot de passe")
' Retrait des protections des feuilles
If exped = "" Then Exit Sub
'Si le champ est vide, la procédure est arrêtée
Wend
DAT = CDate(exped)
Colis = 0
Application.EnableEvents = False
Application.ScreenUpdating = False
Set wscolis = C1
For Ihi = 3 To HI.Range("A" & Rows.Count).End(xlUp).Row
'La macro s'étend de la ligne 3 à la dernière ligne non vide de la feuille "HISTO"
CAB = HI.Range("A" & Ihi)
'On définit la variable CAB comme la référence de code à barre dans la feuille "HISTO"
Set Cell = BD.Range("A2:A" & Range("A" & Rows.Count).Row).Find(CAB, lookat:=xlWhole)
'On recherche dans la feuille "BD" la ou les références de code à barre correspondantes
If Not Cell Is Nothing Then
'Si on trouve cette cellule
If HI.Cells(Ihi, "I") = DAT Then
'Si une date est trouvée
Colis = Colis + 1
'On incrémente le nombre de colis
If Colis = 11 Then Set wscolis = C2: Colis = 1
'Si la variable "Colis" est incrémentée de 11 colis, la feuille "C2" est activée pour poursuivre la macro
If Colis > 20 Then MsgBox "plus de 20 colis trouvés": Exit Sub
'Si la variable "Colis" est incrémentée de plus de 20 colis, la macro renvoi un message d'information et interrompt la procédure
wscolis.Cells(8, Colis + 2) = "LHA" & HI.Range("A" & Ihi)
'CAB Colis
wscolis.Cells(10, Colis + 2) = BD.Range("I" & Cell.Row)
'Date de conditionnement
wscolis.Cells(11, Colis + 2) = HI.Range("K" & Ihi)
'Masse
DT.Cells(Ibd + 3, 10) = HI.Range("E" & Ihi)
'Certificat d'acceptation
DT.Cells(Ibd + 3, 11) = HI.Range("F" & Ihi)
'Code traitement
DT.Cells(Ibd + 3, 12) = HI.Range("G" & Ihi)
'Code emballage
DT.Cells(Ibd + 3, 13) = BD.Range("G" & Cell.Row)
'Code nature
Ibd = Ibd + 1
End If
End If
Next Ihi
HI.Protect ("Mot de passe"), DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowSorting:=True, AllowFiltering:=True
BD.Protect ("Mot de passe"), DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowSorting:=True, AllowFiltering:=True
'L'ordinateur réactive les protections des feuilles
Application.EnableEvents = True
Application.ScreenUpdating = True
If Colis = 0 Then MsgBox "pas de colis trouvé pour le " & exped
'Si la macro ne trouve aucun colis correspondant à la date saisie, un message d'information est renvoyé à l'utilisateur
End Sub
Ma macro fonctionne parfaitement à l'heure actuelle
Débutant en VBA je n'avais encore jamais utilisé le système de boucle, je ne maîtrise pas encore bien cette partie je vais donc pouvoir potasser ça désormais
Encore un grand merci à toi,
Bonne continuation
Bonjour,
je vois que je t'ai laissé un bug
dans ce bout de code
If Colis = 11 Then Set wscolis = C2: Colis = 1
'Si la variable "Colis" est incrémentée de 11 colis, la feuille "C2" est activée pour poursuivre la macro
If Colis > 20 Then MsgBox "plus de 20 colis trouvés": Exit Sub
'Si la variable "Colis" est incrémentée de plus de 20 colis, la macro renvoi un message d'information et interrompt la procédure
devrait être
If Colis = 11 Then if wscolis.name = C1.name then
Set wscolis = C2: Colis = 1
'Si la variable "Colis" est incrémentée de 11 colis, la feuille "C2" est activée pour poursuivre la macro
else
MsgBox "plus de 20 colis trouvés": Exit Sub
'Si la variable "Colis" est incrémentée de plus de 20 colis, la macro renvoi un message d'information et interrompt la procédure
end if