Excel couper coller ligne en VBA

Bonjour
remplace 1 et 2 dans les items de sheets par tes valeurs "A" et "B"

Option Base 1
Option Explicit
Const valeur As String = "servie"
Sub transfèrer()
Dim dercol As Byte
Dim lig As Long, nbre As Long, cptr As Long, cptr2 As Byte
Dim tablo, tablo_lig

    dercol = Sheets(1).Range("IV2").End(xlToLeft).Column
    nbre = Application.CountIf(Sheets(1).Columns(18), valeur)
    ReDim tablo(nbre, dercol)
    ReDim tablo_lig(nbre)
    If nbre > 0 Then
        With Sheets(1)
        lig = 65536
        For cptr = 1 To nbre
            lig = .Columns(18).Find(valeur, .Cells(lig, 18), xlValues).Row
            For cptr2 = 1 To dercol
                tablo(cptr, cptr2) = .Cells(lig, cptr2).Value
            Next
            tablo_lig(cptr) = lig
        Next
        Application.ScreenUpdating = False
        For cptr = nbre To 1 Step -1
            Rows(tablo_lig(cptr)).Delete
        Next
        End With
        With Sheets(2).Range("C1").Resize(nbre, dercol)
            .ClearContents
            .Value = tablo
        End With
    End If
End Sub

edit: tite démo
https://www.cjoint.com/?mvqtH26z5V

Slt,
Merci pour l'info mais j'ai un petit problème, La première partie du code fonctionne mais pas le collage!!!...

Mis a part le nom des feuille, n'y a t'il pas autre chose à modifier dans ton code??? parce que ça bloque au niveau de la ligne "With sheet (2) .Range ("C1") .resize (nbre, dercol)"

Ce petit truc réglé ça devrait fonctionner ensuite.
Merci de ton retour Michel

Bonjour,

je viens de réessayer sur la démo que je t'ai joint: ca marche

With sheets(2) peut-être ou le nom ou numéro de ta feuille sheets(X) ou sheets("machin")

Le truc c'est que ton fichier est un peu différent du mien.
Je t'explique:
Je rentre des info à partir de la ligne 4d'une feuille A. A la 4ème ligne;de la première colonne à la 17 ème colonne sont contenu mes infos
Au bout d'un moment mes infos d'une ligne sont dépassées et dans la colonne 18 de cette ligne je note "servie" grâce à une liste déroulante.
a ce moment je peut avoir plusieurs lignes de remplies et seulement quelques une ayant "servie" dans la colonne 18

Le but étant de passer par un bouton "effacer ligne servie" qui me supprime les lignes ayant la colonne 18 avec "servie", et qui me les colle dans une feuille B (à partir de la ligne 4) où seront archiver toutes les lignes servie!!!!

Merci de ton aide mais la je ne sais pas comment résoudre ce problème.
Si tu as un code plus spécifique à mon Cahier des charges Michel, je suis preneur....lol

désolé mais c'est ce que j'ai fait
met lig à 3 au lieu de 65536 si tu veux et sheets(A) au lieu de sheets(1) et B au lieu de 2
met dercol à 17 (18 si tu conserves le terme "servie" dans la feuille B) si tu veux aussi car tu n'avais pas précisé le nbre de colonnes
pour le bouton ta 1° macro montre que tu sais faire
voilà, as tu fait fonctionner la démo que j'ai pris la peine de te joindre ?

A moins que tu veuilles compiler toutes les lignes "servies" en feuille B après plusieurs remplissages de la feuille A: ce que tu n'avais pas précisé au départ et qu'il me semble peut-être deviner dans ton dernier post

Ci dessous macro avec empilage des lignes "servies" pour plusieurs demandes d'archivage

Option Base 1
Option Explicit
Const valeur As String = "servie"
Sub transfèrer()
Dim dercol As Byte
Dim lig As Long, nbre As Long, cptr As Long, cptr2 As Byte
Dim tablo, tablo_lig
Dim ligvide As Long
    dercol = 17
    nbre = Application.CountIf(Sheets(1).Columns(18), valeur)
    ReDim tablo(nbre, dercol)
    ReDim tablo_lig(nbre)
    If nbre > 0 Then
        With Sheets(1)
        lig = 3
        For cptr = 1 To nbre
            lig = .Columns(18).Find(valeur, .Cells(lig, 18), xlValues).Row
            For cptr2 = 1 To dercol
                tablo(cptr, cptr2) = .Cells(lig, cptr2).Value
            Next
            tablo_lig(cptr) = lig
        Next
        Application.ScreenUpdating = False
        For cptr = nbre To 1 Step -1
            .Rows(tablo_lig(cptr)).Delete
        Next
        End With
        With Sheets(2)
            ligvide = .Range("C65536").End(xlUp).Row + 1
            .Cells(ligvide, 3).Resize(nbre, dercol).Value = tablo
        End With
    End If
End Sub

Merci michel, c'est tout bon