Copier coller une ligne selon un statut

Bonjour,

J'aimerai déplacer les lignes dont la colonne statut est en "terminé" sur une autre feuille, voici le code que j'ai créer mais je n'arrive pas à déterminer à écrire "si la ligne est en statut terminé, déplace là"

Avez-vous svp une idée?

Merci d'avance!!

Sub archivage()

Dim Work1 As Workbook, Work2 As Workbook

'WBSource

'WBDest

Dim i As Integer

Set Work1 = Workbooks("En_cours")

Set Work2 = Workbooks("Archives")

'cherche la ligne vide dans le classeur de destination

i = WBDest.Worksheets(1).Range("A1").End(xlUp).Row + 1

'Copie la 2eme ligne de la premiere feuille dans le classeur source.

'Colle la ligne à la suite de la derniere ligne non vide dans le classeur de

'destination.

Work1.Worksheets(1).Rows(2).Copy _

Destination:=Work2.Worksheets(1).Cells(i, 1)

'Suppression de la ligne dans le classeur source

Work1.Worksheets(1).Rows(2).Delete

'Désactive le mode Couper/Copier

Application.CutCopyMode = False

End Sub

Salut Jana_722,

je pars du fait qu'une fois on change le statut à "terminé", l'archivage doit se faire instantanément/automatiquement

Code à ajouter dans la feuille "En_cours" (pour info une fueille c'est Worksheet, Workbook c'est un classeur)

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Ligne As Long
Set Target = Intersect(Target, Range("E1:E1000")) ' il faut adapter la colonne "Status"
If Target Is Nothing Then Exit Sub
If Target = "terminé" Then
Ligne = Target.Row
Target.EntireRow.Copy _
Destination:=Sheets("Archives").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Target.EntireRow.Delete
End If
End Sub

@++

Bonjour m3ellem1,

Cela fonctionne, merci beaucoup !

Est-il possible de faire la même chose d'un fichier à un autre?

Exemple : j'ai codé une macro afin d'extraire un fichier excel que je reçois quotidiennement par mail. Ce fichier se place dans un dossier et est écrasé tous les jours.

J'aimerai copier les lignes de ce fichier dans un autre fichier Excel stable sur mon ordinateur.

Seulement je ne peux pas coder sur le fichier puisqu'il est écrasé.

As-tu une idée stp?

Promis c'est ma dernière demande

Merci bcp et bon week end!

Salut Jana,

oui c‘est possible, montre ton code et si possible un/des fichier/s exemple/s.

Bonne nuit

Hello m3ellem1 !

En pj tu trouveras les 2 fichiers, test_reçu que je reçois quotidiennement et dont j'aimerai copier les lignes vers le suivi calage_base de donnée.

Voici mon code sur outlook pour me permettre l’extraction du fichier que je reçois à 11h, 14h et 16h ; toujours en cours de construction car il ne fonctionne pas pour le moment. L'idée est qu'à chaque réception le nouveau fichier écrase l'ancien dans mon dossier, et que dès que la ligne est remplie, le copiage-collage fonctionne. Je ne sais pas si cela est réellement possible et si oui où devrais-je coder cela?

J'ai déjà le code du copier coller que tu m'as gentillement proposé, il faut juste ajouter la condition "non vide" et coder le code dans un fichier à part ou sur outlook?

Merci pour ton aide

Dans ThisOutlookSession :

Private Sub Application_NewMail()

Call sauvegardePJ

End Sub

Et dans module :

Sub sauvegardePJ()

On Error Resume Next

Dim MonApp As Outlook.Application

Dim MonNameSpace As Outlook.NameSpace

Dim MonDossier As Outlook.Folder

Dim MonMail As Outlook.MailItem

Dim numero As Integer

Dim strAttachment As String

Dim NbAttachments As Integer

Dim chemin As String

'Instance des objets

Set MonApp = Outlook.Application

Set MonNameSpace = MonApp.GetNamespace("MAPI")

Set MonDossier = MonNameSpace.GetDefaultFolder(olFolderInbox)

numero = MonDossier.Items.Count

Set MonMail = MonDossier.Items(numero)

'chemin de destination des pièces jointes

chemin = "\\FRQSURDTC1VWSFS.code1.emi.philips.com\FR_cl_lifestyle\TEMP\TESTD\"

NbAttachments = MonMail.Attachments.Count

'contrôles possibles:nom de l'expéditeur, adresse mail expéditeur et sujet du mail

'MonMail.SenderName= ""

'MonMail.SenderEmailAddress

'MonMail.Subject

If MonMail.Subject Like "Prise de rendez-vous de 11h00 à 14h00 pour PHILIPS FRANCE" Then

i = 1

Do While i <= NbAttachments

strAttachment = MonMail.Attachments.Item(i).FileName

MonMail.Attachments.Item(i).SaveAsFile chemin & "Calage.xlsb"

i = i + 1

Loop

End If

End Sub

Salut m3ellem1

Update : la macro outlook qui extrait les fichiers fonctionne !