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
'

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

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

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
'

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

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

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

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

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

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

Re:

je crois ce qui sera plus simple, tester mon exemple

dans votre environnement, chez moi c'est nickel

http://www.oricom.ca/lupin/util/archiver.zip
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

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

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

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???

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

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é