VBA - Copier Coller

[Delux]

Bonjour,

Dans un premier temps, je m'excuse pour les accents absent car j'ecris avec un clavier QWERTY.

Je debute en VBA (et oui il faut bien un debut a tout) et j'essaye d'ecrire un code me permetant d'extraire (copier/coller) d'une feuille nommee "Nadia Extraction" des informations en fonction du resultat de la colonne AF (=1).

J'ai deja reussi a copier coller les lignes entieres mais je n'ai pas reussi a faire en sorte que, pour chaque cellule de la colonne AF contenant "1", les lignes soient collees les une apres les autres (la ca me colle tout sur la meme ligne, m'effacant les donnees precedente).

Ce que je souhaite :
- Pour chaque cellule de la colonne AF qui est egale a 1 : copier coller les cellules des colonnes C, E et K correspondantes a la meme ligne que la cellule contenant 1 (en AF).
- Coller les informations dans la feuille "Status" en respectant l'ordre : C en A, E en B, et K en C.
- Faire en sorte que quand je lance la macro les precedentes donnees collees s'effacent pour coller les nouvelles.

Voila, je pense que c'est deja un tres bon debut ^^.

Je vous remercie par avance de votre aide precieuse

Delux

 Sub Copy_Paste()
Dim myRange As Range
Dim Cell As Range
Set myRange = Sheets("Nadia Extraction").Range("AF3:AF400")


For Each Cell In myRange
    If Cell.Value = 1 Then
        Cell.EntireRow.Copy
        
Sheets("Status").Range("A2").Select
    
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=True, Transpose:=False
  
     
     
    End If
 
Next


End Sub

 

[Papou-net]

Re : VBA - Copier Coller

Bonjour Delux,

Puisque tu n'as pas joint de fichier, je n'ai pas pu vérifier mais j'imagine une solution de ce type :

Sub Copy_Paste()
Dim mySource As Range, myCible As Range, Cell As Range
Dim lg As Integer

Set myRange = Sheets("Nadia Extraction").Range("AF3:AF400")
Set myCible = Sheets("Status").Range("A2:C400")

myCible.ClearContents
lg = 2
For Each Cell In mySource
    If Cell.Value = 1 Then
        myCible.Range("A" & lg) = mySource.Range("C" & Cell.Row)
        myCible.Range("B" & lg) = mySource.Range("E" & Cell.Row)
        myCible.Range("C" & lg) = mySource.Range("K" & Cell.Row)
        lg = lg + 0
    End If
Next
End Sub

A toi de tester si ça fonctionne.

Cordialement.

 

[Delux]

Re : VBA - Copier Coller

Salut et merci pour la rapidite de la reponse.
J'avais pourtant attache le fichier mais je n'avais pas vu qu'il etait trop volumineux :/

Cependant je n'arrive pas a l'adapter et ca met une erreur.

Voila j'espere que cella t'apportera un peu plus d'infos

Merci

 

[Delux]

Re : VBA - Copier Coller

Au fait, est-il possible de rajouter des petites explications au code pour que je puisse mieux le comprendre? :$

Merci d'avance

 

[Papou-net]

Re : VBA - Copier Coller

RE Delux,

C'est tout de suite plus clair avec un exemple sous les yeux.

Comme je le craignais, mon code comportait également quelques erreurs mais j'y ai remédié.

Voici donc une version fonctionnelle qui, je n'en doute pas, te conviendra. J'ai ajouté quelques commentaires comme tu me l'as demandé.

Cordialement.

 

[Delux]

Re : VBA - Copier Coller

Re Papou-Net,

Un grand bravo et Merci.

Cela fonctionne a merveille

Maintenant je vais essayer de le completer.

Encore Merci

Cordialement