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
Rechercher des sujets similaires à "macro pre remplir dossier expedition"