Archivage automatique de données

Bonjour,

J'ai utilisé une macro qui me parait fonctionner pas mal sauf que j'ai un petit souci (autrement, je ne serais pas là !)

L'objectif est de basculer les données dans la feuille ARCHIVES lorsque l'etat est à Terminé ou Annulé.

Mon problème est lorsque ma dernière ligne est à Non commencé et mon avant dernière ligne à Terminé, il me supprime ma ligne Non commencé : elle disparait !!

Voici le fichier, si vous pouvez m'aider !

Pour info, je ne suis pas une expert en VBA

Bonjour Roussette35

Je n'ai pas très bien compris l'objectif !

Dans ton exemple l'onglet "ACRH_TRANS" est vide et l'onglet "SAISIE_TRANS.." contient (en ligne 10) un dossier "terminé" celui-ci doit donc passer dans "ARCH_TRANS" cf.

Roussette35 a écrit :

L'objectif est de basculer les données dans la feuille ARCHIVES lorsque l'etat est à Terminé ou Annulé.

Cela veut-il dire que tu cliques sur l'image "dossier" de temps en temps et que tu veux que les dossiers qui passent à l'état

Roussette35 a écrit :

Terminé ou Annulé

Salut Roussette,

Bonsoir Andréa,

fichier protégé, pas pu tester! Sans garantie, je déteste ça!

Cette macro devrait (normalement) copier toute ligne dont le statut passe à 'Terminé" ou "Annulé" vers 'ARCH_TRANS' avec tri de cette dernière et effacement de la ligne de 'SAISIE_TR....'.

A tester!

Si un traitement de masse est préféré avec commande par bouton ou autre, il faudra la modifier, évidemment!

Private Sub Worksheet_Change(ByVal Target As Range)
'
If Not Intersect(Target, Range("K3:K" & Cells(Rows.Count, 11).End(xlUp).Row)) Is Nothing Then
    If Target.Value = "Terminé" Or Target.Value = "Annulé" Then
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        '
        With Worksheets("ARCH_TRANS")
            iRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
            .Range("A" & iRow & ":O" & iRow).Value = Range("A" & Target.Row & ":O" & Target.Row).Value
            .Range("A" & iRow & ":O" & iRow).Sort key1:=.Range("A3"), order1:=xlAscending, Orientation:=xlTopToBottom
        End With
        Rows(Target.Row).Delete shift:=xlUp
        '
        Application.ScreenUpdating = True
        Application.EnableEvents = True
    End If
End If
'
End Sub

A+