Code VBA Copier coller

souquet_vita -
michel_m Messages postés 16602 Date d'inscription Statut Contributeur Dernière intervention - 18 avril 2017 à 14:49

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

Afficher la suite

A voir également:

Code VBA Copier coller
Code ascii - Guide
Historique copier coller - Guide
Copier coller pdf - Guide
Copier-coller - Accueil - Informatique
Style d'écriture a copier coller - Guide

8 réponses

Réponse 1 / 8

patty5046 Messages postés 46 Date d'inscription Statut Membre Dernière intervention 5

Bonjour

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

Bon courage

Réponse 2 / 8

michel_m Messages postés 16602 Date d'inscription Statut Contributeur Dernière intervention 3 314

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

Réponse 3 / 8

souquet_vita

Merci pour vos réponses.

Par contre dans la pratique, pourquoi éviter les copy-paste ?

https://mon-partage.fr/f/NFOI6NV7/

michel_m Messages postés 16602 Date d'inscription Statut Contributeur Dernière intervention 3 314

Par contre dans la pratique, pourquoi éviter les copy-paste ?
très lent
à n'utiliser que si on veut copier les formats, formules....

mais tu n'as pas répondu à ma question concernant ce que tu voulais copier...

Réponse 4 / 8

souquet_vita

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.

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

Posez votre question

Réponse 5 / 8

michel_m Messages postés 16602 Date d'inscription Statut Contributeur Dernière intervention 3 314

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, Tampon
Dim 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").Activate
End Sub

le classeur
https://mon-partage.fr/f/rQ0bpm1M/

Réponse 6 / 8

souquet_vita

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

Réponse 7 / 8

michel_m Messages postés 16602 Date d'inscription Statut Contributeur Dernière intervention 3 314

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, Tampon
Dim 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 Messages postés 16602 Date d'inscription Statut Contributeur Dernière intervention 3 314

errata

au lieu de
Nbre = Application.CountIf(.Range("J" & Derlig & ":J10000"), "OK")
écrire
Nbre = Application.CountIf(.Range("J" & Derlig +1 & ":J10000"), "OK")

Réponse 8 / 8

michel_m Messages postés 16602 Date d'inscription Statut Contributeur Dernière intervention 3 314

MERCI

de rien...

Discussions similaires

dessin au clavier cannabis

Votre réponse

Discussions similaires