Macro

Bonjour le forum,

J'ai un fichier dans lequel en colonne B( de B5 à B20) de l'onglet "SAISIES" je flash des codes barres et qui (merci grandzebu) se retraduisent en code à barre en colonne C.

Le but de ce fichier est d'imprimer tous les colis qui ont été rangés dans un même contenant comme ça au moment de l'expédition il suffit de re-flasher les cab et non de reprendre chaque colis

Mon soucis viens du fait que dès l'impression faite on efface les données et si la feuille est mal imprimée ou disparait il faudrait tout recommencer

Pourriez vous me créer une macro qui enregistrerait ces données les unes à la suites des autres ( l'idéal serait que ces données soient séparées par la date et l'heure de l'impression ou de l'effacement) dans la feuille SAUVEGARDE dans la colonne A si le jour de la semaine est "lundi", colonne B "mardi etc

J'ai encore une demande, si les données du jour de la semaine précédente pouvaient être effacées automatiquement ça serait formidable

Je joint mon fichier

Merci d'avoir pris le temps de me lire et suis attentif à toutes propositions qui simplifierait mes attentes

Cordialement

14flashage-colis.zip (53.39 Ko)

Bonjour Etsije, bonjour le forum,

J'ai modifié la macro effacer comme ça :

Sub effacer()
Dim D As Date
Dim COL As Byte
Dim S As Worksheet

D = Date
COL = Weekday(D)
Set S = Worksheets("SAUVEGARDE")
S.Range(S.Cells(2, COL), S.Cells(Application.Rows.Count, COL).End(xlUp)).ClearContents
With Sheets("SAISIES")
    With .Range("B6:B150")
        .Copy S.Cells(2, COL)
        .ClearContents
    End With
    .Select
    .Range("B6").Select
End With
End Sub

Petite remarque. Tu masque les userForms (Hide) au lieu de les fermer (Unload). C'est pas courant car ils restent en mémoire pour rien...

Bonjour ThauThème, le forum

Merci d'avoir pris du temps pour mon sujet

Ta réponse correspond presque à ce que j'espère

Lors de l'essai que j'ai effectué les données enregistrées précédemment sont effacées or j'aurais souhaité les garder pendant une semaine et donc si ce n'est pas possible par vba je le ferai manuellement mais pourrais tu modifier ta macro dans ce sens c'est à dire coller à la suite de l'enregistrement précédent (avec toujours si c'est possible pour séparer entre deux saisies l'insertion de l'heure)

Encore merci

Cordialement

Re,

Essaie comme ça :

Sub effacer()
Dim SS As Worksheet 'déclare la variable SS (onglet SaisieS)
Dim SE As Worksheet 'déclare la variable SE (onglet SauvegardE)
Dim DL As Byte 'déclare la variable DL (Derniere Ligne)
Dim D As Date 'déclare la variable D (Date)
Dim COL As Byte 'déclare la variable COL (COLonne)
Dim DEST As Range 'déclare la variable DEST (Cellule de DESTination)

Set SE = Worksheets("SAUVEGARDE") 'définit l'onglet SE
Set SS = Worksheets("SAISIES") 'définit l'onglet SS
DL = SS.Cells(Application.Rows.Count, "B").End(xlUp).Row 'définit la dernière ligne éditée DL de la colone B de l'onglet SS
D = Date 'définit la date D
COL = Weekday(D) 'définit la colonne COL (en fonction du jour de la semaine de la date)
'définit la cellule de destination DEST de l'onglet SE (la cellule en ligne 2 de la colonne COL si elle est vide, sinon, la seconde cellule vide de la colonne COL)
Set DEST = IIf(SE.Cells(2, COL) = "", SE.Cells(2, COL), SE.Cells(Application.Rows.Count, COL).End(xlUp).Offset(2, 0))
DEST.Value = "DATE" 'écrit "DATE" dans DEST
DEST.Offset(1, 0).Value = Date 'renvoie la date dans la cellule au-dessous de DEST
If Application.WorksheetFunction.CountIf(SE.Columns(COL), "DATE") = 3 Then 'condition : si la colonne COL contient 3 fois le mot "DATE"
    'suprimme la première série en haut de tableau
    SE.Range(SE.Cells(2, COL), SE.Cells(1, COL).End(xlDown).Offset(1, 0)).Delete shift:=xlShiftUp
End If 'fin de la condition
SS.Range("B6:B" & DL).Copy DEST.Offset(2, 0) 'copie les codes saisis et les colle dans deux cellules en-dessous de DEST
SS.Range("B6:B150").ClearContents 'efface les code saisis
SS.Select 'sélectionne l'onglet SS
SS.Range("B6").Select 'sélectionne la cellule B6 de l'onget SS
End Sub

Re

Super merci

J'ai mis sous format date les cellules de l'onglet "SAISIE" et tes commentaires m'aident beaucoup dans la compréhension de ta macro

j'ai vu que tu définissait la date par D, serait il possible de définir l'heure par H et de l'ajouter à la date dans la même cellule?

Un énorme merci

Cordialement

Re

Remplace :

D = Date

par :

D = Now

bonsoir Thau Thème, le forum

J'ai (je pense) suivi ton conseil et remplacé Date par Now

J'ai aussi modifié le format de cellules en date et heure le soucis c'est que l'heure affichée est toujours 00:00

Ci-dessous copie de ton code avec la rectification en ligne 10

Sub effacer()

Dim SS As Worksheet 'déclare la variable SS (onglet SaisieS)

Dim SE As Worksheet 'déclare la variable SE (onglet SauvegardE)

Dim DL As Byte 'déclare la variable DL (Derniere Ligne)

Dim D As Date 'déclare la variable D (Date)

Dim COL As Byte 'déclare la variable COL (COLonne)

Dim DEST As Range 'déclare la variable DEST (Cellule de DESTination)

Set SE = Worksheets("SAUVEGARDE") 'définit l'onglet SE

Set SS = Worksheets("SAISIES") 'définit l'onglet SS

DL = SS.Cells(Application.Rows.Count, "B").End(xlUp).Row 'définit la dernière ligne éditée DL de la colone B de l'onglet SS

D = Now 'définit la date D

COL = Weekday(D) 'définit la colonne COL (en fonction du jour de la semaine de la date)

'définit la cellule de destination DEST de l'onglet SE (la cellule en ligne 2 de la colonne COL si elle est vide, sinon, la seconde cellule vide de la colonne COL)

Set DEST = IIf(SE.Cells(2, COL) = "", SE.Cells(2, COL), SE.Cells(Application.Rows.Count, COL).End(xlUp).Offset(2, 0))

DEST.Value = "DATE" 'écrit "DATE" dans DEST

DEST.Offset(1, 0).Value = Date 'renvoie la date dans la cellule au-dessous de DEST

If Application.WorksheetFunction.CountIf(SE.Columns(COL), "DATE") = 3 Then 'condition : si la colonne COL contient 3 fois le mot "DATE"

'suprimme la première série en haut de tableau

SE.Range(SE.Cells(2, COL), SE.Cells(1, COL).End(xlDown).Offset(1, 0)).Delete shift:=xlShiftUp

End If 'fin de la condition

SS.Range("B6:B" & DL).Copy DEST.Offset(2, 0) 'copie les codes saisis et les colle dans deux cellules en-dessous de DEST

SS.Range("B6:B150").ClearContents 'efface les code saisis

SS.Select 'sélectionne l'onglet SS

SS.Range("B6").Select 'sélectionne la cellule B6 de l'onget SS

End Sub

Que n'ai je pas fait pour que l'heure effective s'affiche

Avec tous mes remerciements

Bonjour ThauThème, le forum

J'ai relu ton code et effectué le changement d'une deuxième valeur D=Now (ligne 18) ça fonctionne du tonnerre

Un énorme gros merci

Cordialement

Rechercher des sujets similaires à "macro"