Couper/coller d'une feuille à une autre

Bonjour,

Je suis en train de réaliser un fichier pour suivre des actions a menées.

Une fois que ses actions sont terminées je souhaiterais qu'en inscrivant "Done" dans la colonne "J" de ma feuille 1, la ligne complète soit supprimé de ma 1ère feuille et collé dans ma seconde feuille à partir de la ligne 3 (car j'ai des en-têtes au-dessus) et que ses actions soient automatiquement classées de la plus récentes à la plus anciennes.

N'étant pas un expert en VBA j'ai bidouillé ce code :

Sub Todolist()

  Dim Lig     As Long
  Dim Col     As String
  Dim NbrLig  As Long
  Dim NumLig  As Long

  Sheets("Feuille 2").Activate ' feuille de destination

  Col = "J"                 ' colonne de la donnée non vide à tester
  NumLig = 0
  With Sheets("Feuille 1")     ' feuille source
  NbrLig = .Cells(65536, Col).End(xlUp).Row
  For Lig = 1 To NbrLig
    If .Cells(Lig, Col).Value = "Done" Then
      .Cells(Lig, Col).EntireRow.Copy
      NumLig = NumLig + 1
      Cells(NumLig, 1).Select
      ActiveSheet.Paste
    End If
  Next
  End With

End Sub

Et avec ça j'ai plusieurs problèmes, la ligne ne se supprime pas de ma feuille 1 et elle se colle mal dans ma feuille 2 (elle se colle toujours en ligne 1 et 2 et donc supprime certaines actions).

De plus est-il possible de réaliser un bouton permettant d'exécuter automatiquement cette action ?

Je vous joins le fichier pour que cela soit plus compréhensible.

Merci d'avance pour votre aide

19actions.xlsm (65.08 Ko)

Bonjour,

Procédure à copier dans le module Feuil1(Feuille 1).

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lastRow As Long, lRow As Long

    If Not Intersect(Target, Range("J:J")) Is Nothing Then
        If Target.Count > 1 Then Exit Sub

        If Target.Value = "Done" Then
            Application.ScreenUpdating = False
            lRow = Target.Row
            lastRow = Worksheets("Feuille 2").Cells(Rows.Count, 2).End(xlUp).Row + 1
            With Range("B" & lRow & ":M" & lRow)
                .Copy Destination:=Worksheets("Feuille 2").Cells(lastRow, 2)
                .Delete Shift:=xlUp
            End With
        End If
    End If

End Sub

Bonjour Jean-Eric,

Merci beaucoup pour votre aide, j'aurais par contre encore une petite question.

Lorsque j'applique la formule tout fonctionne parfaitement sauf que les tâches terminées apparaissent toutes en ligne 3 et de ce faite elles se suppriment au fur et à mesure

Merci d'avance pour votre solution

Re,

LastRow est calculée pour la colonne 2 (soit colonne B).

lastRow = Worksheets("Feuille 2").Cells(Rows.Count,2).End(xlUp).Row + 1

Essaie avec 10 (soit colonne J).

Ah super je vous remercie beaucoup

Juste pour ma culture ça ne fonctionnait pas corectement car il n'y avait pas d'info dans la colonne B ?

Re,

Oui.

.Cells(Rows.Count,2).End(xlUp).Row

Ce code retourne le numéro de la dernière ligne non vide de la colonne B.

Merci pour tes remerciements.

A bientôt.

Merci vraiment pour vos explications et votre aide, c'est vraiment très gentil de votre part de prendre du temps pour aider les autres.

A bientôt

Bonjour j'ai encore une petite question,

A chaque fois que je démarre mon fichier excel il me faut activer la macro en cliquant sur un petit bouton en bas de page, comme vous pourrez le voir sur la capture d'écran

capturemacro

Y a t-il une méthode qui éviterait de devoir à chaque fois perdre du temps à l'activer, mais que cela s'active automatiquement au démarrage du fichier?

Merci d'avance

J'ai trouvé la réponse à ma question, si ça intéresse quelqu'un je vous donne la solution ci-dessous :

Il suffit de placer ce code en double cliquant sur « This Workbook » et y inscrire ce code :

« Sub Auto_Open() ' déclanchement à l'ouverture du classeur

Sheets("To Do List").Select

End Sub »

Bonne soirée à tous

Rechercher des sujets similaires à "couper coller feuille"