XL 2016 Déplacer une ligne d'une feuille à une autre

Promethee642

XLDnaute Nouveau
Bonjour,

J'ai un classeur comportant 2 feuilles. La feuille 1 (onglet "Listing") et la feuille 2 (onglet "Clôturé").

J'ai ajouter un bouton nommer "Archiver" sur la feuille 1.
J'aimerais que lorsque je clique sur ce bouton "Archiver" les lignes se trouvant sur la feuille 1 et dont la valeur de la colonne C est "Parti" soient déplacées sur la feuille 2.
J'aimerais que les lignes de la feuille 1 qui sont déplacées sur la feuille 2 soient supprimées de la feuille 1.

Pourriez-vous m'aider et me dire quelle macro ajouter à ce bouton pour qu'il effectue ce que je voudrais.


Merci à vous
 
Solution
mais il y a un soucis.
Encore eût il fallu le préciser. :)
En PJ un nouvel essai. Je ne déplace et ne supprime que de A à E.
VB:
Sub Archiver()
    Application.ScreenUpdating = False
    DLListing = Sheets("Listing").Range("B65500").End(xlUp).Row
    With Sheets("Listing")
        For L = DLListing To 2 Step -1
            If .Cells(L, "C") = "Parti" Then
                DLCloturé = 1 + Sheets("Clôturé").Range("C65500").End(xlUp).Row
                .Range("A" & L & ":E" & L).Copy Destination:=Sheets("Clôturé").Range("A" & DLCloturé)
                .Range("A" & L & ":E" & L).Delete Shift:=xlUp
            End If
        Next L
    End With
End Sub

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Promethee642 et bienvenu sur XLD,
Un essai en PJ avec :
VB:
Sub Archiver()
    Application.ScreenUpdating = False
    DLListing = Sheets("Listing").Range("B65500").End(xlUp).Row
    With Sheets("Listing")
        For L = DLListing To 2 Step -1
            If .Cells(L, "C") = "Parti" Then
                DLCloturé = 1 + Sheets("Clôturé").Range("C65500").End(xlUp).Row
                .Rows(L & ":" & L).Copy Destination:=Sheets("Clôturé").Range("A" & DLCloturé)
                .Rows(L & ":" & L).Delete Shift:=xlUp
            End If
        Next L
    End With
End Sub
N'étant pas spécifié, l'archivage se fait avec le format et conservation du lien hypertexte.
 

Pièces jointes

  • Test (9).xlsm
    69.8 KB · Affichages: 6

Promethee642

XLDnaute Nouveau
Merci beaucoup pour ta réponse aussi rapide,

La macro que tu me propose fonctionne très bien mais il y a un soucis.

Serait-il possible de déplacer uniquement les colonnes A, B, C, D et E de la ligne et non pas toute la ligne.

Si les premières lignes de mon tableau où se trouve le bouton on la valeur "Parti". Le bouton se déplace également sur la feuille 2.
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
mais il y a un soucis.
Encore eût il fallu le préciser. :)
En PJ un nouvel essai. Je ne déplace et ne supprime que de A à E.
VB:
Sub Archiver()
    Application.ScreenUpdating = False
    DLListing = Sheets("Listing").Range("B65500").End(xlUp).Row
    With Sheets("Listing")
        For L = DLListing To 2 Step -1
            If .Cells(L, "C") = "Parti" Then
                DLCloturé = 1 + Sheets("Clôturé").Range("C65500").End(xlUp).Row
                .Range("A" & L & ":E" & L).Copy Destination:=Sheets("Clôturé").Range("A" & DLCloturé)
                .Range("A" & L & ":E" & L).Delete Shift:=xlUp
            End If
        Next L
    End With
End Sub
 

Pièces jointes

  • Test (V2).xlsm
    51.2 KB · Affichages: 10

sylvanu

XLDnaute Barbatruc
Supporter XLD
Info comme vous êtes nouveau.
Vous pouvez mettre ce post en Résolu. Cela simplifie la compréhension aux futurs lecteurs, et leur évite de télécharger une mauvaise solution.
 

Collins

XLDnaute Occasionnel
Bonjour sylvanu, Promethee, le forum.

Sylvanu, ta macro devrait me satisfaire dans un de mes fichiers, sauf que j'ai 2 colonnes en plus. Une "date" en col B et une "Montant" en col E. Peux tu me modifier la macro du dernier fichier en #4 , j'essaie par tous les moyens de changer les lettres, les chiffres et je n'y arrive pas.
Je te remercie.

 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Collins,
Les colonnes B et E sont déjà copiées.
Si cela veut dire que les colonnes ajoutées sont F et G alors :
VB:
Sub Archiver()
    Application.ScreenUpdating = False
    DLListing = Sheets("Listing").Range("B65500").End(xlUp).Row
    With Sheets("Listing")
        For L = DLListing To 2 Step -1
            If .Cells(L, "C") = "Parti" Then
                DLCloturé = 1 + Sheets("Clôturé").Range("C65500").End(xlUp).Row
                .Range("A" & L & ":G" & L).Copy Destination:=Sheets("Clôturé").Range("A" & DLCloturé)
                .Range("A" & L & ":G" & L).Delete Shift:=xlUp
            End If
        Next L
    End With
End Sub
Si ça ne marche pas, alors ouvrez un nouveau post avec un fichier test.
 

Collins

XLDnaute Occasionnel
Merci beaucoup de ta réponse
je prend le même exemple que Promethee et regarde les colonnes que j'ai en +par rapport à lui (la B et La E)
1634224151828.png


j'ai mis ta macro que tu m'as modifiée et rien ne se passe quand j'archive.
 

Collins

XLDnaute Occasionnel
Bonjour Sylvanu

j'ai mis cet If et dans un 1er temps ça n'a pas marché parce que j'avais "PARTI" en majuscule comme ci-dessous
If Lcase(.Cells(L, "C")) = "PARTI" Then
En le mettant en minuscule il n'y a pas eu de problème.
je me débrouille en faisant des essais :)
Un grand merci encore.
 

Discussions similaires

Statistiques des forums

Discussions
311 712
Messages
2 081 802
Membres
101 819
dernier inscrit
lukumubarth