Compter nb de cellules en couleur et copier vers d'autres feuilles

[ABDELHAK]

Bonjour le forum,

Je m’essaye à la VBA mais hélas sans succès. Voici donc ma nouvelle requête si vous le voulez bien entendu.
J’ai un fichier avec +/- 5500 lignes :
( A2:A5500 ) = dates
( B2:U2 ) = ligne 2 ( 20 chiffres avec des cellules à fond vert et des cellules sans remplissage )
( B3:U3 ) = ligne 3 ( 20 chiffres avec des cellules à fond vert et des cellules sans remplissage )
( B4:U4 ) = ligne 4 ( 20 chiffres avec des cellules à fond vert et des cellules sans remplissage )
( B5:U5 ) = ligne 5 ( 20 chiffres avec des cellules à fond vert et des cellules sans remplissage )
Et ainsi de suite ……
( B5500:U5500 ) = ligne 5500 ( 20 chiffres avec des cellules à fond vert et des cellules sans remplissage )

J’aimerais que la macro compte le nombre des cellules à fond vert ligne par ligne

1. Si ce nombre < 6 alors supprimer la ligne
2. Si ce nombre = 7 alors copier / coller la ligne vers sheet ( C7 )
3. Si ce nombre = 8 alors copier / coller la ligne vers sheet ( C8 )
4. Si ce nombre = 9 alors copier / coller la ligne vers sheet ( C9 )
5. Si ce nombre = 10 alors copier / coller la ligne vers sheet ( C10 )

Je joins une pièce jointe.

En espérant avoir été claire et précis, je vous remercie d’avance pour tout ce vous avez déjà fait pour moi.

Amicalement vôtre.

Abdelhak

 

[Robert]

Re : Compter nb de cellules en couleur et copier vers d'autres feuilles

Bonsoir Abdelhak, bonsoir le forum,

Peut-être comme ça :

Sub Macro1()
Dim O As Object 'déclare la variable O (Onglet)
Dim DL As Long 'déclare la variable DL (Dernière Ligne)
Dim PL As Range 'déclare la variable PL (PLage)
Dim LI As Long 'déclare la variable LI (LIgne)
Dim COL As Byte 'déclare la variable COL (COLonne)
Dim NB As Byte 'déclare la variable NB (NomBre)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Set O = Sheets("Feuil3") 'définit l'onglet O
DL = O.Cells(Application.Rows.Count, 1).End(xlUp).row 'définit la dernière ligne éditée DL de la colonne 1 (=A) de l'onglet O
For LI = DL To 2 Step -1 'boucle 1 : inversée de la dernière ligne DL à la ligne 2 (par pas de 1)
    NB = 0 'initialise le nombre NB
    For COL = 2 To 21 'boucle 2 : des colonnes 2 (=B) à 21 (=U)
        'si l'interieur de la cellule est vert, incrémente le nombre NB
        If O.Cells(LI, COL).Interior.ColorIndex = 4 Then NB = NB + 1
    Next COL 'prochaine cellule de la boucle 2
    Select Case NB 'agit en fonction du nombre NB
        Case Is < 6 'cas inférieur à 6
            Rows(LI).Delete 'supprime la ligne
        Case 7, 8, 9, 10 'cas égal à 7, 8, 9 ou 10
            'définit la cellule de destination DEST
            Set DEST = Sheets("Chiffre_" & NB).Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0)
            Rows(LI).Copy DEST 'copy la ligne LI et la colle dans DEST
    End Select 'fin de l'action en fonction du nombre
Next LI 'prochaine ligne d ela boucle 1
End Sub

 

[ABDELHAK]

Re : Compter nb de cellules en couleur et copier vers d'autres feuilles

Bonjour ROBERT,

Merci d’avoir répondu à ma requête. Il y a plusieurs problèmes lorsque j’exécute la macro.

Primo lorsqu’elle efface les lignes (< 6) les lignes possédant 6 cellules à fond vert ne sont pas supprimées.

Secundo lorsqu’elle doit copier coller les lignes (> 7) il ya un message d’erreur qui apparaît à la ligne n° 17 du code VBA que vous m’avez envoyé.
« Set DEST = Sheets("Chiffre_" & NB).Cells(Application.Rows.Count, , 1).End(xlUp).Offset(1, 0)”

J’ai essayé d’exécuter celle-ci par étape mais avec les mêmes résultats cités ci-dessus.

Y a-t-il moyen que vous modifiez le code mais étape par étape ?
C'est-à-dire une macro qui compte uniquement les lignes ayant 10 cellules à fond vert et qui exécute un copier / coller vers sheet(Chiffre_10).
La feuille contenant les données à traiter = sheet(TAB_DONNEES) dans mon fichier source.

Dans touts les cas, 1000 merci’………..is et encore merci

Amicalement vôtre

ABDELHAK

 

[Robert]

Re : Compter nb de cellules en couleur et copier vers d'autres feuilles

Bonjour Abdelhak, bonjour le forum,

En pièce jointe ton fichier exemple modifié. J'ai suprimé l'onglet C_10 (j'ai pas compris à quoi il servait !), copié l'onglet Feuil3 (Feuil3 (2)) pour que tu puisses voir avant et après la macro et laissé uniquement la première ligne dans les autres onglets. Si tu lances la macro tu verras quelle ne plante absolument pas.
Les ligne sont effacées (compare les onglet Feuil3 et Feuil3 (2)) et regarde dans les autres onglets les lignes y sont bien reportées ! Pour supprimer aussi les lignes contenant 6 cellules vertes il faut écrire [<=6] et non pas [<6] !

Ton fichier exemple ne contient aucun onglet nommé TAB_DONNEES et l'erreur doit venir du nom des onglets qui doit être différent. Si tu veux une macro adaptée à ton fichier original il faut :
• soit que tu sois capable d'adapter tout seul le code (c'est pour cela que je m'emm...de à le commenter)
• soit que tu fournisses un fichier exemple correspondant à la réalité de ton fichier original !

Sinon on ne fait que perdre du temps... Je veux bien modifier la macro mais avec le BON fichier !

 

[Staple1600]

Re : Compter nb de cellules en couleur et copier vers d'autres feuilles

Bonjour à tous

EDITIONII: [FlashOver] En fait c'est mon Excel qui fait des siennes (pourquoi? j'en sais rien)
(Quel que soit le VBA que j’exécutais -> Message d'erreur: Exécution interrompue )
Je reboot et relance une session et Excel fonctionne de nouveau comme un charme.
Quelqu'un ici a-t-il déjà eu ce problème* ? (W7+Excel 2013)
*: Problème référencé sur le net (ici par exemple)
Et a-t-il une autre parade que le reboot ?

Robert:
Ton code plante chez moi (Excel 2013)
Et le mien aussi.
Et j'arrive pas à trouver pourquoi dans les deux cas
Code VBA:
Sub a()
Dim Dlg&, i&, x&, f As Worksheet
'On Error Resume Next
With Sheets("XXX")
Dlg = .Cells(Rows.Count, 1).End(xlUp).row
For i = Dlg To 2 Step -1
x = nbvert(.Cells(i, 2).Resize(, 20))
Select Case x
Case Is < 6
.Rows(i).Delete
'Case Is >= 6
Case 7, 8, 9, 10
.Cells(i, 1).Resize(, 21).Copy Sheets("CHIFFRE_" & CStr(x)).Cells(Rows.Count, 1).End(3)(2)
'Case Else
'End
End Select
Next i
End With
End Sub

Function nbvert(r As Range)
Application.Volatile
Dim c As Range, cpt&
cpt = 0
For Each c In r
If c.Interior.ColorIndex = 4 Then
cpt = cpt + 1
End If
Next c
nbvert = cpt
End Function

EDITION: Je viens d'avoir un flash.
Je ferme ma session et je reviens.

 

[ABDELHAK]

Re : Compter nb de cellules en couleur et copier vers d'autres feuilles

Bonjour ROBERT,

Merci d’avoir réagi aussi vite. J’ai suivi à la lettre vos instructions et bingo vous avez vu juste. La macro fonctionne parfaitement .Mon fichier original différait de la pièce jointe que je vous avais envoyée.
C’est pour cela que « la macro ne tournait pas rond ».
Toutes mes excuses donc, malgré vos nombreuses recommandations pour être claire et précis, cela reste une grande difficulté pour nous les utilisateurs de votre merveilleux site à l’être.
Je voudrais également vous remercier pour toutes les notes explicatives qui accompagnent les lignes du code que vous avez réalisé.
Je ne le répèterai jamais assez, j’ai un immense respect pour ce que vous êtes et ce que vous faites.
Il faut que vous le sachiez, sans votre aide, je ne serais jamais arrivé au bout de mon rêve farfelu, au grand jamais…
Grâce à vous, pour la 1ière fois de ma vie, j’ai réussi à mener un projet jusqu’à son terme.
Et au-delà de l’aide que vous m’avez si gentiment accordée pour réalisé mon projet, il y a « le joyau de la couronne » et il se résume par le fait que je vous ai rencontré. Cela n’a pas de prix.
Je vous serai reconnaissant à vie.
1000 merci’………..is et encore merci .

Amicalement vôtre

ABDELHAK

 

[Staple1600]

Re : Compter nb de cellules en couleur et copier vers d'autres feuilles

Bonjour ABDELHAK

ABDELHAK
Et moi je pue de la gueule?
Ou tes lunettes sont restées sur ta table de chevet et tu ne m'as pas vu passé dans ton fil?
Est-ce que mon code VBA fonctionne sur ton PC ?

 

[Robert]

Re : Compter nb de cellules en couleur et copier vers d'autres feuilles

Bonjour Abdelhak, Staple, bonjour le forum,

Mais p... c'est quoi cette odeur ?
Bon Abdelhak, c'est bien gentil mais tu en fais quand même beaucoup trop, tellement même que Staple a pris la mouche (remarque l'avait qu'à fermer sa bouche...). Désolé Staple mais je suis trop mort de rire... et je sais que tu vas le prendre avec humour.

 

[Staple1600]

Re : Compter nb de cellules en couleur et copier vers d'autres feuilles

Re

Monsieur Robert
Sachez que j'ai le chicot vertueux, que je le caresse tous les jours avec une brosse dure.
Je dis pas que parfois quelques remugles stomacaux peuvent surgir les jours de bombance.
Mais ce midi j'ai mangé léger, et bu anglais.
Enfin bref, c'est pas l'odeur qui fait plantouiller notre VBA.
(De plus j'ai les pieds propres)

Avez-vous constater ce phénomène? (voir mon message précédent)
Sur votre PC ?

PS: J'ose espérer qu'ABDELHAK m'a simplement zappé suite à une histoire de mauvais rafraîchissement.
Sinon je peux citer ma marque de dentifrice ou aller de suite me faire un bain de bouche et sucer une pastille Valda pour lever ses derniers doutes

 

[ABDELHAK]

Re : Compter nb de cellules en couleur et copier vers d'autres feuilles

Bonjour Staple1600,

Faut pas prendre la mouche comme cela l’ami, ce que j’ai dit à notre ami Robert est valable également pour job75, CISCO, vgendron, Staple1600 et à tous ceux qui dans le forum donnent de leur temps pour aider des nulles en VBA dans mon genre par exemple.
Cette affirmation est profonde et sincère.Ceci dit, j’ai essayé votre code mais hélas il y a un message d’erreur à la ligne n°5 {x = nbvert(.Cells(i, 2).Resize(, 20)}
Comme mes connaissances sont plus que limitées en VBA, je vous suggèrerai de consulter le code que notre ami ROBERT à réaliser.
Il fonctionne à merveille.
En tous cas pardon et merci, pour votre aide.

A +

 

[Staple1600]

Re : Compter nb de cellules en couleur et copier vers d'autres feuilles

Re


ABDELHAK
Vite, on rechausse ses lunettes
https://www.excel-downloads.com/thr...uleur-et-copier-vers-dautres-feuilles.219644/
J'ai déjà testé le code de Robert.
C'est d'ailleurs grâce à cela que j'ai soulevé un lièvre.
PS: Mon code fonctionne sur ton fichier exemple.
(Il est d'ailleurs similaire à celui du sieur Robert, je passe par une fonction pas lui)
(Si sur ton PC, ton fichier est différent du fichier exemple, l'erreur peut venir de là.)
Mais plus surement l'erreur vient du fait que j'ai renommé la feuille 3 en XXX sans te le préciser.
Désolé.


Et je ne prends pas la mouche , je fais simplement de l'ironie à la Staple1600

 

[vgendron]

Re : Compter nb de cellules en couleur et copier vers d'autres feuilles

Bonjour à tous,
Abdelhack: Vous dites avoir mené à terme votre projet.. est ce que ca veut dire que ce post n'a plus lieu d'être?
https://www.excel-downloads.com/threads/copier-coller-colonnes-par-rapport-date.219488/

je dis ca. parce que je viens ENFIN de comprendre ce que vous voulez ;-)

 

[ABDELHAK]

Re : Compter nb de cellules en couleur et copier vers d'autres feuilles

Bonjour a tous

c est loin d etre termine quand on touche a la vba on ne peut plus s en passer.
Disons que je passerai a la seconde phase en essayant de comprendre toutes ses lignes de codes et peut etre essayer de realiser quelques unes

amicalement votre

abdelhak

 

[ABDELHAK]

Re : Compter nb de cellules en couleur et copier vers d'autres feuilles

Bonjour vgendron

au contraire cela ne fait que commencer. Je vais passer a la phase 2. Elle sera longue et plein d embuche c est sure mais tres passionnante : La comprehension de ses hieroglyphes que sont les lignes des codes vba. A propos pour notre derniere conversation pouvez-vous jeter un dernier coup d oeil. Si vous le voulez.

A+

abdelhak

 

[Staple1600]

Re : Compter nb de cellules en couleur et copier vers d'autres feuilles

Re

je dis ca. parce que je viens ENFIN de comprendre ce que vous voulez ;-)

vgendron:
J'ai retenu un mot présent dans les commentaires du code VBA : KENO

J'en déduis qu'il s'agit d'utiliser Excel(le pôvre) pour essayer de créer une énième martingale pour gagner au KENO...
Me-trompe-je ABDELHACK ?