Trouver / copier ligne de couleur et coller dans autre feuille

dol91 Messages postés 2 Date d'inscription   Statut Membre Dernière intervention   -  
dol91 Messages postés 2 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour,

Je rencontre un probleme insoluble pour moi , neo pratiquant de VBA .
je desire , apres avoir coller un tableau dans une feuille , rechercher les lignes colorées en jaune et les coller dans une autre feuille appelée "synthese" les unes sous les autres ..

Voici mon code :

Dim Cellule1 As Range, Cellule2 As Range
Dim lig As Integer, col As Integer
Dim flag As Boolean
lig = 3: col = 1
With Sheets("Feuil1")
For Each Cellule1 In Intersect(.Range("A:A"), .UsedRange)
For Each Cellule2 In Intersect(.Rows(Cellule1.Row), .UsedRange)
If Cellule2.Interior.Color = RGB(255, 255, 0) Then
Sheets("Synthese").Cells(lig, col) = Cellule2
col = col + 1
flag = True
End If
Next Cellule2
If flag = True Then lig = lig + 1: flag = False
Next Cellule1
End With

Il marche assez bien pour rechercher et coller la 1ere ligne jaune trouvée mais ne fonctionne plus des qu'il en trouve une autre . Ou il la colle a la suite sur la meme ligne , ou n'importe ou ... Et surtout , des que je refais la manoeuvre avec un nouveau tableau le lendemain , la nouvelle ligne jaune trouvée ecrase la precedente .

Je m'arrache les cheveux ! ( et Dieu sait qu'il m'en reste deja peu ...)

Quelqu'un peut-il m'aider ?

Merci par avance




A voir également:

3 réponses

Zoul67 Messages postés 1959 Date d'inscription   Statut Membre Dernière intervention   149
 
Bonjour,

Le flag doit faire des siennes. Ton code me semble un peu compliqué.
Peut-être peux-tu t'inspirer de ça :
derLigne = Sheets("Données").Range("A" & Rows.Count).End(xlUp).Row
ligneDest = Sheets("Synthèse").Range("A" & Rows.Count).End(xlUp).Row + 1

For i = 2 To derLigne
    If Sheets("Données").Cells(i, 1).Interior.Color = RGB(255, 255, 0) Then
        Sheets("Données").Cells(i, 1).EntireRow.Copy
        Sheets("Synthèse").Activate
        Cells(ligneDest, 1).Select
        ActiveSheet.Paste
        ligneDest = ligneDest + 1
    End If
Next i


A+
0
Gyrus Messages postés 3334 Date d'inscription   Statut Membre Dernière intervention   526
 
Bonjour,

A priori, ton code n'est pas conçu pour rechercher les lignes colorées en jaune et les coller dans une autre feuille appelée "synthese" les unes sous les autres ..
Il cherche dans la plage utilisée les cellules colorées en jaunes et il les colle en lignes et colonnes suivant l'ordre de recherche.

Pour permettre aux intervenants de t'aider efficacement, il est souhaitable que tu joignes un fichier à ta demande avec un exemple de résultat souhaité.

Pour joindre le fichier, tu peux utiliser https://www.cjoint.com/
Ensuite, reviens coller ici le lien donné par le site.

A+
0
dol91 Messages postés 2 Date d'inscription   Statut Membre Dernière intervention  
 
Bonjour !

Pour commencer , je voulais vous remercier pour vos reponses rapides !
Apres adaptation de ton code , Zoul67 , il fonctionne tres bien et remplit la fonction voulue .
Merci encore et bonne jourée à tous !
0