[Excel] Archivage d'une ligne de données.

Question

Bonjour,

J'aimerai pouvoir archiver des lignes de données reprenant des dates et des heures entre les colonnes "J" et "V" de mon tableau de la feuille "A" (Composé des colonnes de "A" à "AH").
La condition de déclenchement de l'archivage est que une heure soit inscrite dans la colone "U".
L'archivage doit s'effectuer sur la feuille "B", chaque ligne archivée doit s'inscrire l'une en dessous de l'autre à partir de la donnée "A5".
Je connais assez bien excel mais malheureusement pas son système de programmation! Pourriez-vous m'aider svp.

Merci,

Alain

JvDo · Answer

Bonjour,

ça doit être très clair pour toi mais je ne sais pas en te lisant si tu veux récupérer des lignes ou des cellules (entre J et V) et peut-être uniquement celles qui sont des dates ou des heures.

Quant à ta colonne U qui est celle qui identifie les zones à archiver, quelle est l'heure critère?

Dernier point, une zone archivée peut-elle être archivable à nouveau?
Si non, comment les différencies-tu?

le plus simple pour tout le monde c'est que tu montes un exemple de tes données sur le site Cjoint.

Cordialement

Utilisateur anonyme · Answer

Bonjour,

Effectivement, il manque beaucoup d'information !

En supposant :

que le nom de la feuille A est [ FeuilleA ]
que le nom de la feuille B est [ FeuilleB ]
qu'un enregistrement est constitué des colonnes A à AH
que les données de l'enregistrement sont situés entre J et V
que la cellule de départ pour l'archivage est A5
que la colonne [ J ] n'est jamais vide
que la colonne [ U ] possède un format heure standard [ hh:mm:ss ]

que une fois les données archivés, la lgne complete de la feuille A sera détruite

un exemple de code à placer derrière la feuule A :


Option Explicit
'
Const FeuilleTrav = "FeuilleA"
Const FeuilleArch = "FeuilleB"
'

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Region As Range, Plage As String, Position As Long, Temps As Date
    
    ' N'affiche pas le traitement
    Application.ScreenUpdating = False
    ' Trouve dernière ligne
    Position = Range("J2:J65535").End(xlDown).Row
    ' Recherche intersection valide
    Set Region = Application.Intersect(Range("U1:U" & Position), Target)
    
    If Region Is Nothing Then
        'MsgBox "La cible n'est pas dans la plage visé."
    Else
'        MsgBox "La cible est dans la plage visé."
        ' Si temps plus grand que 8 heures
        Temps = Target.Value
        If (Temps > "08:00:00") Then
            ' Désactive évènement
            Application.EnableEvents = False
            ' Défini plage à copier
            Plage = "J" & Target.Row & ":V" & Target.Row
            ' Sélectionne la plage à copier
            Range(Plage).Select
            ' Avec la sélection
            With Selection
                ' Place dans presse-papier
                .Copy
                ' Appel de fonction
                CopieVersArchive
            End With
            ' Désactive le copier/coller
            Application.CutCopyMode = False
            ' Sélectionne la cellule visé
            Target.Select
            ' Détruit la ligne qui a été archivé
            Target.EntireRow.Delete
            ' Réactive les évènement
            Application.EnableEvents = True
        End If
    End If
    ' Mise à jour de l'affichage activé
    Application.ScreenUpdating = True
    
End Sub
'

Function CopieVersArchive()

' Plage [ J , V ] dans plage [ A , AH ]
' Déclenchement sur condition heure, colonne [ U ]
' Case de départ de stockage Feuille B [ A5 ]

    Dim Plage As String, Position As Long
    
    ' Défini la pemière ligne libre
    Position = Sheets(FeuilleArch).Range("A5:A65535").End(xlDown).Row + 1
    Plage = "A" & Position
    ' Copie les données sur la ligne
    Sheets(FeuilleArch).Range(Plage).PasteSpecial
    Plage = "A" & (Position + 1)
    ' Sélectionne la case suivante
    Sheets(FeuilleArch).Select
    ActiveSheet.Range(Plage).Select
    ' Retourne à la FeuilleA
    Sheets(FeuilleTrav).Select

End Function
'


Ce code fonctionne sous mon environnement,  soyez-prudent !

Lupin

Utilisateur anonyme · Answer

Bonjour,

Il manque une information :

comme JvDo a mentionné :

... , une zone archivée peut-elle être archivable à nouveau?
Si non, comment les différencies-tu? 

je cite :

... Une fois l'archivage effectué, les données de la feuille "HKM GMN" ne doivent pas être supprimée mais bien seulement copiées.

Existe-t-il une collonne qui permette de savoir s'il y a eu archivage ?

Lupin

Utilisateur anonyme · Answer

Bonjour,

vous ajouter encore une condition qui change le tout !

je cite :

Bien sûr, le ré-archivage doit alors "écraser" l'ancienne ligne erronée sur la feuille "archive".

---------------

Attendu que la première spécification étant d'archivé à partir
de A5, maintenant il faut localiser l'archive pour réécrire.

Il faut donc un champs clé, spécifier une collonne non-vide
et toujours distinte (valeurs différentes)  qui servira de
 "clé primaire" pour les 2 feuilles.

Cela facilitera la requête pour localiser l'archive, elle pourra être
coder (modifier) en début de programme.

Lupin

Utilisateur anonyme · Answer

re :

dans tous les cas, il me semble impératif de fixer une colonne index
qui aura toujours une valeur distincte, genre un numéro qui s'incré-
mente automatiquement.

pour simplifier le travail, en exemple je pourrais rajouter une nou-
velle colonne [ a - aj ], et j'inscrirais le numéro de ligne de l'archive.
C'est à dire qu'au moment d'écrire l'archive sur le feuille archive,
il y aurait aussi sauvegarde du numéro de ligne de le feuille archive
sur la feuille source qui donnerait l'adresse en cas de mise à jour
de l'archive "écraser".

cette solution vous semble elle acceptable ?

Lupin

Utilisateur anonyme · Answer

Bonjour,

Alors voici ce que ça donne :

Lo code a placer derrière la feuille :

Option Explicit
'
Const Cod_Archive = "A"

Const FeuilleTrav = "HKM GMN"
Const FeuilleArch = "Archivage"
'

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Region As Range, Position As Long, Temps As Date
    Dim Adresse As String, Plage As String, NbrArc As Long
    Dim Valeur As Variant
    
    Application.ScreenUpdating = False
    Position = Range("J2:J65535").End(xlDown).Row
    Set Region = Application.Intersect(Range("U1:U" & Position), Target)
    
    If Region Is Nothing Then
        'MsgBox "La cible n'est pas dans la plage visé."
    Else
        'MsgBox "La cible est dans la plage visé."
        Temps = Target.Value
        If (Temps > "08:00:00") Then
            Valeur = Range("Ai" & Target.Row).Value
            Valeur = Mid(Valeur, (Len(Cod_Archive) + 1))
            Valeur = Val(Valeur)
            If (Valeur > 0) Then
                Valeur = Range("AJ" & Target.Row).Value
            Else
                Valeur = 0
            End If
            Application.EnableEvents = False
            Plage = "J" & Target.Row & ":V" & Target.Row
            Range(Plage).Select
            With Selection
                .Copy
                Adresse = CopieVersArchive(Valeur)
                If (Adresse <> "") Then
                    Range("AJ" & Target.Row).Value = Adresse
                    Adresse = Mid(Range("Ai" & Target.Row).Value, (Len(Cod_Archive) + 1))
                    If (Adresse <> "") Then
                        Range("Ai" & Target.Row).Value = Cod_Archive & (Adresse + 1)
                    Else
                        Range("Ai" & Target.Row).Value = Cod_Archive & "1"
                    End If
                Else
                    Range("AJ" & Target.Row).Value = ""
                End If
            End With
            Application.CutCopyMode = False
            ActiveCell.Offset(1, 0).Select
            Target.Select
            Application.EnableEvents = True
        End If
    End If
    Application.ScreenUpdating = True
    
End Sub
'

Function CopieVersArchive(ByVal PlgTmp As Variant) As String

    Dim Plage As String, Position As Long
    
    Position = Sheets(FeuilleArch).Range("A4:A65535").End(xlDown).Row + 1
    
    If (PlgTmp = 0) Then
        Plage = "A" & Position
    Else
        Plage = PlgTmp
    End If
    
    Sheets(FeuilleArch).Range(Plage).PasteSpecial
    Plage = "A" & (Position + 1)
    Sheets(FeuilleArch).Select
    ActiveSheet.Range(Plage).Select
    Sheets(FeuilleTrav).Select
    If PlgTmp = 0 Then
        CopieVersArchive = "A" & Position
    Else
        CopieVersArchive = PlgTmp
    End If

End Function
'

si vous tenter de faire un copier coller sur une cellule de la colonne U l'évènement est déclenché et ça plante, normal il n'y as pas de gestion d'évènement ce qui est très lourd...

si vous devez arrêter la macro, vous aurez besoin les évènements
seront désactivé, vous aurez besoin de ceci pour réactiver :

Sub ActiveEvenement()
    Application.EnableEvents = True
End Sub
'

et pour désactiver le déclenchement des évènements :

Sub DesactiveEvenement()
    Application.EnableEvents = False
End Sub
'

Colonne [ AI ] , la lettre A codé dans la constante [ Cod_Archive ]
suivi d'un nombre indiquant le nombre de fois archivé.

Colonne [ AJ ], adresse (lettrechiffre) de la ligne archivé

amusez-vous :-)

Lupin

Utilisateur anonyme · Answer

Bonjour,

Le code doit être placé derrière la feuille HKM GMN

a.)
n.b. Valider le nom des feuilles en debut de code,
le compilateur (interprèteur) est sensible à la casse.

b.)
pour copier coller, soyez vigilent lors de saut de ligne de l'editeur du forum, celle-ci devrait attérir en rouge dans l'éditeur de VBA.

dans l'éditeur VBA, on retrouve une fenêtre de code à droite
et 2 fenêtres à gauche, celle du haut donne la liste des objets
du projet. On peut y retrouver 4 types d'objets

Feuilles (Sheets)
Classeur (ThisWorkbook)
Fonction (Module)
Module de classe (ClassModule)

il faut repérer l'objet Feuille HKM GMN, effectuer un double-clic
l'éditeur ouvre alors la fenêtre de droite sur la feuille de code
correspondante à l'objet.

c.)
les deux petites routines pour activer/désactiver les évènements
doivent être placé dans un module pour être accessible du menu
Excel ->> //Outils/Macro/Macros...

bon courage

Lupin

Utilisateur anonyme · Answer

re:

voilà, ce qu'il faut comprendre :

effectivement j'ai omis de modifier le nom de la feuille d'archivage,
méa culpa, toutes mes excuses !

une fois que le programme a planté, il est presque sur que les
évènements sont désactivés à cause de la ligne :

                  Application.EnableEvents = False


 il vous faut réactiver les évènements du classeur en utilisant la routine :

Sub ActiveEvenement()
    Application.EnableEvents = True
End Sub
'

celle-ci doit être coller dans un module pour être accessible du menu Excel.

Menu Excel ->> //Outils/Macro/Macros.../ActiveEvenement 

Lupin

Utilisateur anonyme · Answer

re:

alors voilà, il ne faut pas modifier les noms de constante :

Function CopieVersARCHIVE(ByVal PlgTmp As Variant) As String 

Dim Plage As String, Position As Long 

Position = Sheets(FeuilleARCHIVE).Range("A4:A65535").End(xlDown).Row + 1. 

est et doit rester :

Function CopieVersArchive(ByVal PlgTmp As Variant) As String 

Dim Plage As String, Position As Long 

Position = Sheets(FeuilleArch).Range("A4:A65535").End(xlDown).Row + 1

c'est plutôt à la définition de constante qu'il faut modifier le nom
de la feuille :

en début de code vous avez l'expression suivante :
Const FeuilleTrav = "HKM GMN"
Const FeuilleArch = "Archivage"
'
deviendra plutôt :

Const FeuilleTrav = "HKM GMN"
Const FeuilleArch = "ARCHIVE"
'

Lupin

Utilisateur anonyme · Answer

re:

je crois ce qui sera plus simple, tester mon exemple

dans votre environnement, chez moi c'est nickel

https://www.oricom.ca/404/
ce lien n'est que temporaire, désolé :-(

qu'arrive-t-il chez vous et si ça plante, vérifier la
version exacte de Excel !

Excel 2002 10.2614.2625

Vérifier les options régionales, qu'elles sont-elles ?

En fait, adresser une feuille à partir d'une feuille est toujours
plus délicat que de l'adresser à partir d'un module.

Lupin

Utilisateur anonyme · Answer

Bonjour,

Tout le plaisirs est pour moi :-)

Je sais que si l'instruction :
Sheets(FeuilleArch).Range("A4:A65535").End(xlDown).Row + 1
ne fonctionne pas bien !

assurez-vous que de A1 à A5 les cellules soient non-vide sur la feuille archive et modifier par :

Sheets(FeuilleArch).Range("A1:A65535").End(xlDown).Row + 1

Lupin

Utilisateur anonyme · Answer

suite :

en tentant de modifier la ligne :

Const FeuilleArch = "Archivage"

pour :

Const FeuilleArch = "Archive"

la routine à planté exactement au même endroit que vous !

J'ai donc réinitialiser le nom de la constante en le modifiant :

Sous VBE :
//Menu/Édition/Remplacer

FeuilleArch
Par
FeuilleArchive

Une fois le nom de la constante remplacer dans tous le programme

je m'assure que le compilateur est bien accroché sur le nom de la 
constante en modifiant la casse d'une lettre :

ex :

de Const FeuilleArchive = ...

je modifie

à Const FeuilleArcHive = ...

Dans le programme le nom doit suivre automatiquement sans
autre interventions.

je vous fais grace du pourquoi et du comment, sachez simplement
que le compilateur (l'interprèteur) a une mémoire !

Lupin

titi14200 · Answer

Bonjours,

voila je souhaiterais faire pour mon boulot une macro qui me paraît similaire...
je souhaiterais savoir si il est possible de creer une macro pour archiver toutes les données d'une ligne dans laquelle une cellule est assignée à une date de RDV et que cette dernière est dépassée.
je m'explique, je suis artisan et dans le cadre de mon emploi je prend mes RDV sur excel dans un tableau en assignant une ref un nom une adresse et un numéro de tel sur chaque ligne de rdv mais je n'ai pas toujours le temps d'aller à mon RDV et je voudrais que tous mes rdv louppés soient enregistrés dans une feuille annexe et ainsi reprendre un RDV avec les personnes concernées...
Est-ce possible???

titi14200 · Answer

déjà est-il possible de faire apparaitre la date du jour sur excel car une simple comparaison je saurais faire mais je n'arrive pas à le faire à partir de la date du jour sans avoir à la rentrer manuellement?

Merci de vos réponses

René · Answer

Bonjour,

j'ai un tableau avec deux feuilles à plusieurs colonnes.
dans la première feuille j'ai une colonne  pour mettre un "x"
et je voudrais que dans la deuxième feuilles vienne s'ajouter
la ligne ou j'ai mis mon "x" mais pas en sautant les lignes.
comment puis-je faire.
si vous voulez je peux vous envoyer par mail un exemple du tableau.
à bientôt

René

[Excel] Archivage d'une ligne de données.

15 réponses

Discussions similaires

Newsletters