Excel couper coller ligne en VBA Résolu

Question

Bonjour,

J'ai déjà tester un code mais sans réussite vu que j'ai quelques lacune en VBA
Je cherche à couper toutes les lignes d'une feuille(A) qui ont dans la colonne R le texte "Servie", puis à coller ces lignes dans une autre feuille(B) à la suite les unes des autres. Petits problème c'est qu'il faut que les lignes se copient à la suite des info déjà entrée précédemment

Voici mon code:
Private Sub CommandButton1_click()
    
    Sheets("A").Select
    If Columns("R:R").Text = "Servie" Then
    Selection.Cut
    Sheets("B").Select
    Range("C65536").End(xlUp).Offset(1, -2).Select
    ActiveSheet.Paste
    End If
        Unload Menu
        Sheets("B").Select
End Sub


Merci de le corriger si posibble

michel_m · Answer

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

gunbafo · Answer

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

michel_m · Answer

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")

gunbafo · Answer

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

michel_m · Answer

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

michel_m · Answer

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

gunbafo · Answer

Merci michel, c'est tout bon

Excel couper coller ligne en VBA

7 réponses

Votre réponse

Newsletters