Excel couper coller ligne en VBA

Résolu
gunbafo Messages postés 55 Date d'inscription   Statut Membre Dernière intervention   -  
gunbafo Messages postés 55 Date d'inscription   Statut Membre Dernière intervention   -
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
A voir également:

7 réponses

Réponse 1 / 7
michel_m Messages postés 16602 Date d'inscription   Statut Contributeur Dernière intervention   3 314
 
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
0
Réponse 2 / 7
gunbafo Messages postés 55 Date d'inscription   Statut Membre Dernière intervention   3
 
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
0
Réponse 3 / 7
michel_m Messages postés 16602 Date d'inscription   Statut Contributeur Dernière intervention   3 314
 
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")
0
Réponse 4 / 7
gunbafo Messages postés 55 Date d'inscription   Statut Membre Dernière intervention   3
 
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
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 7
michel_m Messages postés 16602 Date d'inscription   Statut Contributeur Dernière intervention   3 314
 
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
0
Réponse 6 / 7
michel_m Messages postés 16602 Date d'inscription   Statut Contributeur Dernière intervention   3 314
 
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


0
gunbafo Messages postés 55 Date d'inscription   Statut Membre Dernière intervention   3
 
Re Michel,

J'ai résolu le problème mais il se trouve qu'en faisant des tests, un petit Bug se présente. Si l'utilisateur clic sur le bouton "servie" alors qu'aucune ligne n'est notée "servie", alors le programme bloque.

est-t'il possible d'éviter ce bug ou mieux, mettre un msgbox "Aucune commande servie"???

Merci Michel si tu as la solution
0
michel_m Messages postés 16602 Date d'inscription   Statut Contributeur Dernière intervention   3 314 > gunbafo Messages postés 55 Date d'inscription   Statut Membre Dernière intervention  
 
Bonjour,

Comme tu avais coché résolu, j'ai supprimé le classeur...

pourtant on a
nbre = Application.CountIf(Sheets(1).Columns(18), valeur) 'donne le nombre de "servie" dans la colonne 18
....
If nbre > 0 Then 'si le nombre est supérieur à Zéro
..... on effectue le transfert dans la feuille2
End if
enD sub

donc, si tu n"as pas de "servie" tu sors de la macro
si tu veux un message avant End if
insère avant ce "End if" ces 2 lignes
Else
Msgbox ""Aucune commande servie"
0
gunbafo Messages postés 55 Date d'inscription   Statut Membre Dernière intervention   3 > michel_m Messages postés 16602 Date d'inscription   Statut Contributeur Dernière intervention  
 
J'ai bien compris le code et c'est vrai que la logique est respectée.
Mais le problème apparait avant le "If", c'est cette ligne qui bug
"ReDim tablo(nbre, dercol)"

Merci de ton aide!

Sinon merci pour le Msgbox, je me demandais ou il fallait l'insérer.
0
Réponse 7 / 7
gunbafo Messages postés 55 Date d'inscription   Statut Membre Dernière intervention   3
 
Merci michel, c'est tout bon
0