Macro pour couper coller une ligne vers une autre feuille

[jeanpaul]

Bonjour,

Pouvez vous m'aider à faire cette macro. Je voudrais que les lignes contenant le mot "libéré" en colonne 21 soient coupé collé à partir de la colonne 7 seulement (ligne en vert) jusqu'à la colonne 24. Après le couper il faut que la ligne remonte vers le haut (pas de cases vides). Le coller doit se faire vers la feuille "archives" à la suite des autres lignes à chaque fois que j'actionnerai la macro. Je vous ai joint le fichier!! 🙂

Merci d'avance!! Cordialement.

 

[vgendron]

Re : Macro pour couper coller une ligne vers une autre feuille

Salut,

Vu que le fichier joint ne contient pas beaucoup de données..
essaie d'intégrer ce code dans ton fichier d'origine..

Sub CouperColler()

Dim i As Integer
Dim lastline As Integer
lastline = Cells(65536, 7).End(xlUp).Row

For i = lastline To 3 Step -1
    If Cells(lastline, 21) = "Libéré" Then
        Range("G" & i & ":X" & i).Select
    Selection.Cut
    Sheets("Archives").Select
    
    Range("A65536").End(xlUp).Offset(1, 0).Select
    ActiveSheet.Paste
    Sheets("QM lot").Select
    Selection.Delete Shift:=xlUp
    End If
Next i
End Sub

 

[jeanpaul]

Re : Macro pour couper coller une ligne vers une autre feuille

ça marche presque! en fait il faut que toutes les lignes contenant le mot libéré soient couper coller lorsque je clique la macro. Là je dois cliquer une par une pour qu'elles se coupent collent. Merci beaucoup!

 

[vgendron]

Re : Macro pour couper coller une ligne vers une autre feuille

Salut,
oups.. je crois qu'il y a une petite erreur dans le code.. essai celui ci. (lastline est remplacé par i. dans la condition if dans la boucle...)

Sub CouperColler()

Dim i As Integer
Dim lastline As Integer
lastline = Cells(65536, 7).End(xlUp).Row

For i = lastline To 3 Step -1
    If Cells(i, 21) = "Libéré" Then
        Range("G" & i & ":X" & i).Select
    Selection.Cut
    Sheets("Archives").Select
    
    Range("A65536").End(xlUp).Offset(1, 0).Select
    ActiveSheet.Paste
    Sheets("QM lot").Select
    Selection.Delete Shift:=xlUp
    End If
Next i
End Sub