Code VBA Copier coller Fermé

Question

Bonjour, 

Débutante en VBA j'aurai aimé avoir le conseil de l'un d'entre vous. Le code ne marche pas mais je ne trouve pas la solution.
En gros je souhaite copier des lignes (de la colonne 1 à 9) de la feuille Analyses 2 dans la feuille Factures2 seulement si dans la colonne 11 il est indiqué OK.

Merci de votre aide


Private Sub CopyRows()
    Sheets("Analyses2").Select
    ' Find the last row of data
    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
    ' Loop through each row
    For x = 3 To FinalRow
        ' Decide if to copy based on column K
        ThisValue = Cells(x, 11).Value
        If ThisValue = "OK" Then
            Range(Cells(x, 1), Cells(x, 9)).Copy
            Sheets("Factures2").Activate
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Cells(NextRow, 1).Select
            ActiveSheet.Paste
            Sheets("Analyses2").Select
            
            End If
    Next x
End Sub

patty5046 · Answer

Bonjour

J'ai testé ce code chez moi, il fonctionne...

Bon courage

michel_m · Answer

Bonjour,

apparemment ca marche 
 mais tu pourrais faire mieux 
par ex:
 éviter d'activer sans cesse les feuilles pour le confort des yeux
ne boucler que sur le nombre de X
éviter les copy-paste si tu souhaites inscrire que des valeurs...

donc,
Mettre le classeur sans données confidentielles en pièce jointe sur « mon-partage.fr »et faire un clic droit-coller le raccourci  dans votre message 
Dans l’attente

souquet_vita · Answer

Merci pour vos réponses.

Par contre dans la pratique, pourquoi éviter les copy-paste ?

https://mon-partage.fr/f/NFOI6NV7/

souquet_vita · Answer

Ah pardon ! En fait je souhaiterais copier les lignes de la feuille analyses2 (de la colonne 1 à 9) dans la feuille Factures2 si dans la colonne Résultat il y a bien marqué OK. Sinon on ne copie pas la ligne.

michel_m · Answer

re,

les entêtes dde la feuille factures ne correspondaient pas à celle de l'analyse
j'ai rectifié dans l'ordre "analyses
j'ai ajouté des commentaires bidon et n OK en fin de liste (86) pour tester

Code proposé:
Option Explicit'---------------------------------------------Sub copier_si_ok()Dim Nbre As Integer, Cptr As Integer, Lig As Integer, TamponDim Ligvid As Integer    'fige le défilement de l'écran: confort visuel,rapidité    Application.ScreenUpdating = False        'collecte avec la feuille "analyses"    With Sheets("Analyses2")        'nbre de OK colonne J        Nbre = Application.CountIf(.Columns("J"), "OK")        Lig = 2 'départ analyses         'Recherche ligne colonne J ="OK"        For Cptr = 1 To Nbre            Lig = .Columns("J").Find(what:="OK", after:=.Cells(Lig, "J")).Row            'valeurs colonnes A--->I à recopier            Tampon = .Range(.Cells(Lig, "A"), .Cells(Lig, "I"))            'on recopie dans la feuille  facture            With Sheets("Factures2")                '1°ligne vide                Ligvid = .Columns("A").Find(what:="", after:=.Range("A1")).Row                'recopie les valeurs de l 'analyse OK sur la ligne et 9 colonnes (A--->I)                .Cells(Ligvid, "A").Resize(1, 9) = Tampon            End With        Next    End With    ' montrer les factures    Sheets("Factures2").ActivateEnd Sub

le classeur
https://mon-partage.fr/f/rQ0bpm1M/

souquet_vita · Answer

Merci Michel, 

Je l'ai testé mais j'ai une petite question. Si je ne veux pas qu'il recopie à chaque fois l'ensemble des lignes où il y a OK (et du coup je me retrouve avec plein de doublon), est ce qu'il faut que je modifie la boucle, en la faisant démarrer seulement à partir des nouvelles lignes ou bien je peux ajouter une partie dans le code qui supprime les doublons crées ?

Emilie

michel_m · Answer

Bonjour

Pourquoi demander quelque chose de faux ??? 
ce n'est pas un manque de connaissance en VBa mais un manque d'analyse du système d'information voulu...
:-((

en la faisant démarrer seulement à partir des nouvelles lignes
ub copier_si_ok()Dim Nbre As Integer, Derlig As Integer, Cptr As Integer, Lig As Integer, TamponDim Ligvid As Integer    'fige le défilement de l'écran: confort visuel,rapidité    Application.ScreenUpdating = False        'collecte avec la feuille "analyses"    With Sheets("Analyses2")        Derlig = .Columns("A").Find(what:="*", searchdirection:=xlPrevious).Row        Nbre = Application.CountIf(.Range("J" & Derlig & ":J10000"), "OK")        If Nbre = 0 Then Exit Sub        Lig = Derlig 'départ analyses--         .......'suite sans changement 

 Michel

michel_m · Answer

MERCI

de rien...

Code VBA Copier coller

8 réponses

Discussions similaires

Newsletters