Excel couper coller ligne en VBA

Résolu/Fermé

gunbafo Messages postés 55 Date d'inscription jeudi 16 juillet 2009 Statut Membre Dernière intervention 18 février 2011 - 21 déc. 2009 à 14:46
gunbafo Messages postés 55 Date d'inscription jeudi 16 juillet 2009 Statut Membre Dernière intervention 18 février 2011 - 23 déc. 2009 à 13:45

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:

Excel couper coller ligne en VBA
Aller à la ligne excel - Guide
Liste déroulante excel - Guide
Couper une video - Guide
Vente en ligne particulier - Guide
Formule excel - Guide

7 réponses

Réponse 1 / 7

michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
21 déc. 2009 à 16:08

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

Réponse 2 / 7

gunbafo Messages postés 55 Date d'inscription jeudi 16 juillet 2009 Statut Membre Dernière intervention 18 février 2011 3
22 déc. 2009 à 08:36

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

Réponse 3 / 7

michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
22 déc. 2009 à 10:08

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

Réponse 4 / 7

gunbafo Messages postés 55 Date d'inscription jeudi 16 juillet 2009 Statut Membre Dernière intervention 18 février 2011 3
22 déc. 2009 à 15:39

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

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

Posez votre question

Réponse 5 / 7

michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
22 déc. 2009 à 16:27

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

Réponse 6 / 7

michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
22 déc. 2009 à 18:44

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 Messages postés 55 Date d'inscription jeudi 16 juillet 2009 Statut Membre Dernière intervention 18 février 2011 3
23 déc. 2009 à 11:40

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

michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303 > gunbafo Messages postés 55 Date d'inscription jeudi 16 juillet 2009 Statut Membre Dernière intervention 18 février 2011
23 déc. 2009 à 12:21

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"

gunbafo Messages postés 55 Date d'inscription jeudi 16 juillet 2009 Statut Membre Dernière intervention 18 février 2011 3 > michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023
23 déc. 2009 à 13:45

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.

Réponse 7 / 7

gunbafo Messages postés 55 Date d'inscription jeudi 16 juillet 2009 Statut Membre Dernière intervention 18 février 2011 3
23 déc. 2009 à 10:19

Merci michel, c'est tout bon

Discussions similaires

Dessiner avec son clavier et avec des lettres

Statut « en ligne » alors que non

Que veut dire "correspondant occupé" lors d'un appel ?

Discussions similaires

Newsletters