XL 2013 Macro pour définir une cellule couper et copier la ligne dans autre classeur

VALY

XLDnaute Nouveau
Bonjour,
Je suis plus que débutante en VBA mais avec votre forum et avec votre aide j'arrive à glaner des informations pour essayer de faire des macro.
Voila j'ai un fichier de 200000 lignes, j'utilise ce fichier pour des envois courriers et lorsque j'ai des retours je scanne les enveloppes via le formulaire.
Cette partie fonctionne bien, NPAI se note dans la colonne B et la colonne C se met en vert.
Maintenant je souhaiterai que la ligne pour laquelle est notée NPAI se sélectionne, se coupe de mon fichier initial et s'inscrive dans un autre classeur appelé retour. Classeur que je souhaiterai ouvrir automatiquement lorsque je clic sur le bouton affiche formulaire.
Comme je scanne à la file il faut que chaque ligne NPAI viennent se rajouter derrière les dernières lignes de ma feuille 1 du classeur Retour.
Depuis plusieurs jours , j'ai essayé de faire différents tests mais je n'arrive à rien, toutes les lignes se dupliquent dans mon classeur retour.
Merci d'avance pour votre aide.
 

Pièces jointes

  • TEST MACRO NPAI.xlsm
    34.2 KB · Affichages: 12

Hasco

XLDnaute Barbatruc
Repose en paix
Bonjour,

Dans la macro suivante la copie se fera de ligne à ligne
VB:
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    Dim Desti As Range, re As Range

    'Range("C2:C400000").Interior.ColorIndex = 2

    If TextBox1 <> "" Then
        Set re = Range("C2:C400000").Find(TextBox1.Value, lookat:=xlWhole)
        If Not re Is Nothing Then
            re.Interior.ColorIndex = 43
            re.Offset(, -1) = "NPAI"
            ' Intersection des colonne A:G et de la ligne de re
            Set Source = Intersect(ThisWorkbook.Sheets("Feuil1").[A:G], re.EntireRow)
            Source.Copy Workbooks("Classeur1").Sheets("FEUIL1").Cells(Rows.Count, 1).End(xlUp)(2)
        End If
    End If

    TextBox1.Value = ""
    Cancel = True
End Sub

Changez le nom du classeur "Classeur1" par le nom de votre classeur 'Retour' que vous ne nous avez pas communiqué.

Cordialement
 

Hasco

XLDnaute Barbatruc
Repose en paix
Re

Mieux vaut tester la colonne C dans votre classeur Retour, car il y a des lignes où vous n'aurez rien en A (abscence de groupe)
VB:
Source.Copy Workbooks("Classeur1").Sheets("FEUIL1").Cells(Rows.Count, 3).End(xlUp)(2)
cordialement
 

VALY

XLDnaute Nouveau
Merci pour votre réponse.
J'ai un soucis, lorsque je scanne l'enveloppe, la ligne est bien sélectionnée et copier dans le classeur Retour (qui a exactement la même configuration que le tableau initial) mais lorsque je scanne la seconde enveloppe, c'est la ligne de la seconde enveloppe qui remplace celle copier précédemment et donc dans le fichier Retour, même si je scanne plusieurs enveloppes il n'y a qu'une seule ligne sur le tableau.
Si c'est possible je souhaiterai également que la ligne copiée du classeur initial soit automatiquement supprimée.
Merci.
 

Hasco

XLDnaute Barbatruc
Repose en paix
mais lorsque je scanne la seconde enveloppe, c'est la ligne de la seconde enveloppe qui remplace celle copier précédemment
Bonjour,

Je vous ai donné la réponse hier soir dans le post#3
Si c'est possible je souhaiterai également que la ligne copiée du classeur initial soit automatiquement supprimée.
Vous auriez pu trouver en cherchant un peu :
VB:
            Set Source = Intersect(ThisWorkbook.Sheets("Feuil1").[A:j], re.EntireRow)
            Source.Copy Workbooks("Classeur1").Sheets("FEUIL1").Cells(Rows.Count, 3).End(xlUp)(2).Offset(, -2)
            Source.Delete xlShiftUp
Le .Offset(, -2) permet de coller en colonne A puisque la colonne testée est la C
 

VALY

XLDnaute Nouveau
Bonjour Monsieur,
Je vous remercie pour votre retour. Je sens l'agacement dans votre réponse, mais sachez que j'ai cherché. Seulement voila, je suis débutante et probablement pas très douée, j'avoue même que j'ai essayé d'analyser et comprendre le code que vous m'avez adressé (notamment avec le livre de VBA formation débutant) mais ce n'est vraiment pas simple pour moi. Ceci étant je vous remercie chaleureusement puisque grâce à votre aide j'ai la solution. Merci beaucoup :)
 

Discussions similaires