Classement des lignes

Le
romeo59181
Ce message est composé et au format MIME.

=_NextPart_000_1359_01C8E141.9547E5A0
Content-Type: text/plain;
charset="iso-8859-1"
Content-Transfer-Encoding: quoted-printable

Bonjour,

Je recherche une solution pour mon fichier excel 2007

C'est un fichier d'environ 3000 lignes de type annuaire,

Tous les jours mon fichier est modifier en mettant une ligne en couleur =


Ce que je recherche c'est une solution macro ou autre pour que ma ligne =
colorée aille automatiquement sous une feuille donnée

En espérant avoir été clair,

Romeo59181
=_NextPart_000_1359_01C8E141.9547E5A0
Content-Type: text/html;
charset="iso-8859-1"
Content-Transfer-Encoding: quoted-printable

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<HTML><HEAD>
<META http-equiv=Content-Type =
content=text/html;charset=iso-8859-1>
<META content="MSHTML 6.00.6000.16681" name=GENERATOR></HEAD>
<BODY id=MailContainerBody
style="PADDING-RIGHT: 10px; PADDING-LEFT: 10px; PADDING-TOP: 15px"
bgColor=#ffffff leftMargin=0 topMargin=0 CanvasTabStop="true"
name="Compose message area">
<DIV><FONT face=Arial size=2>Bonjour, </FONT></DIV>
<DIV><FONT face=Arial size=2></FONT>&nbsp;</DIV>
<DIV><FONT face=Arial size=2>Je recherche une solution pour mon =
fichier excel
2007 </FONT></DIV>
<DIV><FONT face=Arial size=2></FONT>&nbsp;</DIV>
<DIV><FONT face=Arial size=2>C'est un fichier d'environ 3000 lignes =
de type
annuaire,</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT>&nbsp;</DIV>
<DIV><FONT face=Arial size=2>Tous les jours mon fichier est modifier =
en mettant
une ligne en couleur </FONT></DIV>
<DIV><FONT face=Arial size=2></FONT>&nbsp;</DIV>
<DIV><FONT face=Arial size=2>Ce que je recherche c'est une solution =
macro ou
autre pour que ma ligne colorée aille automatiquement sous une feuille =
donnée
</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT>&nbsp;</DIV>
<DIV><FONT face=Arial size=2>En espérant avoir été =
clair,</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT>&nbsp;</DIV>
<DIV><FONT face=Arial size=2>Romeo59181</FONT></DIV></BODY></HTML>

=_NextPart_000_1359_01C8E141.9547E5A0--
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses Page 1 / 3
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
FFO
Le #12880621
Salut à toi

Solution Macro

For Each c In Worksheets("Feuil1").Range("A1", "A" &
Worksheets("Feuil1").Range("A65535").End(xlUp).Row)
If c.Interior.ColorIndex <> xlNone Then
c.EntireRow.Copy Sheets("donnée").Range("A65535").End(xlUp).Offset(1, 0)
Exit For
End If
Next

Cette macro recopie de l'onglet "Feuil1" vers l'onglet "donnée" une seule
ligne colorée

Il est important que seule cette ligne soit en couleur et aucune autre sinon
il faudrait connaitre la couleur utilisée

Celà devrait convenir

Dis moi !!!!
romeo59181
Le #12884661
Bonjour,

Ok,

Alors maintenant que je sais cela possible voici le détails des couleurs
utilisées :

Couleur ==>> Nom onglet

Rouge ==> Négatif
Jaune ==>> Manque de données
Bleu ==>> Portable
Orange ==>> A Rap
Blanc Arrière plan 1 plus sombre 25% ==>> A Rap Avec Date
Vert ==>> Losc
Vert d'eau ==>> Losc + Braderie ( Ce sont 2 onglets différents )
Rose ==>> Braderie

Voilà,

Si au passage tu peut m'expliquer comment mettre en place la dite macro ça
serait le must,

Encore merci

@+

Romeo59181

"FFO" discussion :
Salut à toi

Solution Macro

For Each c In Worksheets("Feuil1").Range("A1", "A" &
Worksheets("Feuil1").Range("A65535").End(xlUp).Row)
If c.Interior.ColorIndex <> xlNone Then
c.EntireRow.Copy Sheets("donnée").Range("A65535").End(xlUp).Offset(1, 0)
Exit For
End If
Next

Cette macro recopie de l'onglet "Feuil1" vers l'onglet "donnée" une seule
ligne colorée

Il est important que seule cette ligne soit en couleur et aucune autre
sinon
il faudrait connaitre la couleur utilisée

Celà devrait convenir

Dis moi !!!!





FFO
Le #12886241
Rebonjour à toi

Pour créer une Macro dans ton fichier:

Outil/Macro/Nouvelle macro
Nom de la macro : mettre un nom
Ok
Cliques sur le carré bleu de l'icone "Arr"
Puis
Outil/Macro/Macros
Sélectionnes le nom de ta macro
Modifier

Entre le Sub et le End Sub mets ces lignes :

For Each c In Worksheets("Feuil1").Range("A1", "A" &
Worksheets("Feuil1").Range("A65535").End(xlUp).Row)
If c.Interior.ColorIndex = 3 Then
c.EntireRow.Copy Sheets("Négatif").Range("A65535").End(xlUp).Offset(1, 0)
Exit For
End If
If c.Interior.ColorIndex = 6 Then
c.EntireRow.Copy Sheets("Manque de
données").Range("A65535").End(xlUp).Offset(1, 0)
Exit For
End If
If c.Interior.ColorIndex = 5 Then
c.EntireRow.Copy Sheets("Portable").Range("A65535").End(xlUp).Offset(1, 0)
Exit For
End If
If c.Interior.ColorIndex = 46 Then
c.EntireRow.Copy Sheets("A Rap").Range("A65535").End(xlUp).Offset(1, 0)
Exit For
End If
If c.Interior.ColorIndex = 15 Then
c.EntireRow.Copy Sheets("A Rap Avec
Date").Range("A65535").End(xlUp).Offset(1, 0)
Exit For
End If
If c.Interior.ColorIndex = 42 Then
c.EntireRow.Copy Sheets("Losc").Range("A65535").End(xlUp).Offset(1, 0)
c.EntireRow.Copy Sheets("Braderie").Range("A65535").End(xlUp).Offset(1, 0)
Exit For
End If
If c.Interior.ColorIndex = 7 Then
c.EntireRow.Copy Sheets("Braderie").Range("A65535").End(xlUp).Offset(1, 0)
Exit For
End If
Next

Chaque couleur est traitée par ces lignes :

If c.Interior.ColorIndex = 3 Then
c.EntireRow.Copy Sheets("Négatif").Range("A65535").End(xlUp).Offset(1, 0)
Exit For
End If

If c.Interior.ColorIndex = 3 reprèsente le code de la couleur traitée (ici
le 3 pour le rouge)

Sheets("Négatif") est le nom de l'onglet de destination

Si tu souhaites rajouter des couleurs tu prends un exemple de ces lignes que
tu recopies avant le Next de la fin
Puis tu adaptes le code couleur et le nom de l'onglet de destination

Pour connaître le code couleur tu colories une cellule de cette couleur et
aprés l'avoir sélectionné tu exécutes la macro suivante (aprés l'avoir créée):

MsgBox (ActiveCell.Interior.ColorIndex)


Une boîte de dialogue te donneras le code couleur de cette cellule

Tu peux aussi modifier les lignes existantes dans ce code en fonction d'une
nouvelle couleur ou d'un nouveau nom d'onglet

Je suppose qu'une seule couleur sera à traiter par fichier
Dans le cas contraire si plusieurs couleurs par fichier devaient être
recopiées dans les onglets appropriés il faudrait ihniber les ligne "Exit
For" en mettant une cote devant ainsi :

'Exit For

Ou les supprimer

Je te joint un exemple sur ce lien :

http://www.cijoint.fr/cjlink.php?file=cj200807/cij3ViDvH2.xls.

Fais des essais et dis moi !!!!
romeo59181
Le #14488281
Bonjour,

Le tri ne effectue pas ...

Lorsque j'execute la macro la fenetre s'en va mais le tri ne se fait pas ...

Que faire,

Veut tu mon fichier ? Mon tél ?

@+

Romeo59181

"FFO" discussion :
Rebonjour à toi

Pour créer une Macro dans ton fichier:

Outil/Macro/Nouvelle macro
Nom de la macro : mettre un nom
Ok
Cliques sur le carré bleu de l'icone "Arr"
Puis
Outil/Macro/Macros
Sélectionnes le nom de ta macro
Modifier

Entre le Sub et le End Sub mets ces lignes :

For Each c In Worksheets("Feuil1").Range("A1", "A" &
Worksheets("Feuil1").Range("A65535").End(xlUp).Row)
If c.Interior.ColorIndex = 3 Then
c.EntireRow.Copy Sheets("Négatif").Range("A65535").End(xlUp).Offset(1, 0)
Exit For
End If
If c.Interior.ColorIndex = 6 Then
c.EntireRow.Copy Sheets("Manque de
données").Range("A65535").End(xlUp).Offset(1, 0)
Exit For
End If
If c.Interior.ColorIndex = 5 Then
c.EntireRow.Copy Sheets("Portable").Range("A65535").End(xlUp).Offset(1, 0)
Exit For
End If
If c.Interior.ColorIndex = 46 Then
c.EntireRow.Copy Sheets("A Rap").Range("A65535").End(xlUp).Offset(1, 0)
Exit For
End If
If c.Interior.ColorIndex = 15 Then
c.EntireRow.Copy Sheets("A Rap Avec
Date").Range("A65535").End(xlUp).Offset(1, 0)
Exit For
End If
If c.Interior.ColorIndex = 42 Then
c.EntireRow.Copy Sheets("Losc").Range("A65535").End(xlUp).Offset(1, 0)
c.EntireRow.Copy Sheets("Braderie").Range("A65535").End(xlUp).Offset(1, 0)
Exit For
End If
If c.Interior.ColorIndex = 7 Then
c.EntireRow.Copy Sheets("Braderie").Range("A65535").End(xlUp).Offset(1, 0)
Exit For
End If
Next

Chaque couleur est traitée par ces lignes :

If c.Interior.ColorIndex = 3 Then
c.EntireRow.Copy Sheets("Négatif").Range("A65535").End(xlUp).Offset(1, 0)
Exit For
End If

If c.Interior.ColorIndex = 3 reprèsente le code de la couleur traitée (ici
le 3 pour le rouge)

Sheets("Négatif") est le nom de l'onglet de destination

Si tu souhaites rajouter des couleurs tu prends un exemple de ces lignes
que
tu recopies avant le Next de la fin
Puis tu adaptes le code couleur et le nom de l'onglet de destination

Pour connaître le code couleur tu colories une cellule de cette couleur et
aprés l'avoir sélectionné tu exécutes la macro suivante (aprés l'avoir
créée):

MsgBox (ActiveCell.Interior.ColorIndex)


Une boîte de dialogue te donneras le code couleur de cette cellule

Tu peux aussi modifier les lignes existantes dans ce code en fonction
d'une
nouvelle couleur ou d'un nouveau nom d'onglet

Je suppose qu'une seule couleur sera à traiter par fichier
Dans le cas contraire si plusieurs couleurs par fichier devaient être
recopiées dans les onglets appropriés il faudrait ihniber les ligne "Exit
For" en mettant une cote devant ainsi :

'Exit For

Ou les supprimer

Je te joint un exemple sur ce lien :

http://www.cijoint.fr/cjlink.php?file=cj200807/cij3ViDvH2.xls.

Fais des essais et dis moi !!!!



FFO
Le #14488221
Rebonjours à toi

Je t'ai transmis un code pour recopier des lignes colorées non pas pour
exécuter un tri
J'ai du mal à comprendre ton attente

Tu peux me transmettre ton fichier par le biais de ce site :

http://www.cijoint.fr/index.php

Communiques moi le lien pour le récupérer ainsi que toutes les explications
nécessaire à l'objectif souhaité

Merci
Péhemme
Le #14488201
Bonjour,

Retire les Exit For (mets un ' devant) de chaque If Then

Michel

"romeo59181" news:
Bonjour,

Le tri ne effectue pas ...

Lorsque j'execute la macro la fenetre s'en va mais le tri ne se fait pas
...

Que faire,

Veut tu mon fichier ? Mon tél ?

@+

Romeo59181

"FFO" discussion :
Rebonjour à toi

Pour créer une Macro dans ton fichier:

Outil/Macro/Nouvelle macro
Nom de la macro : mettre un nom
Ok
Cliques sur le carré bleu de l'icone "Arr"
Puis
Outil/Macro/Macros
Sélectionnes le nom de ta macro
Modifier

Entre le Sub et le End Sub mets ces lignes :

For Each c In Worksheets("Feuil1").Range("A1", "A" &
Worksheets("Feuil1").Range("A65535").End(xlUp).Row)
If c.Interior.ColorIndex = 3 Then
c.EntireRow.Copy Sheets("Négatif").Range("A65535").End(xlUp).Offset(1, 0)
Exit For
End If
If c.Interior.ColorIndex = 6 Then
c.EntireRow.Copy Sheets("Manque de
données").Range("A65535").End(xlUp).Offset(1, 0)
Exit For
End If
If c.Interior.ColorIndex = 5 Then
c.EntireRow.Copy Sheets("Portable").Range("A65535").End(xlUp).Offset(1,
0)
Exit For
End If
If c.Interior.ColorIndex = 46 Then
c.EntireRow.Copy Sheets("A Rap").Range("A65535").End(xlUp).Offset(1, 0)
Exit For
End If
If c.Interior.ColorIndex = 15 Then
c.EntireRow.Copy Sheets("A Rap Avec
Date").Range("A65535").End(xlUp).Offset(1, 0)
Exit For
End If
If c.Interior.ColorIndex = 42 Then
c.EntireRow.Copy Sheets("Losc").Range("A65535").End(xlUp).Offset(1, 0)
c.EntireRow.Copy Sheets("Braderie").Range("A65535").End(xlUp).Offset(1,
0)
Exit For
End If
If c.Interior.ColorIndex = 7 Then
c.EntireRow.Copy Sheets("Braderie").Range("A65535").End(xlUp).Offset(1,
0)
Exit For
End If
Next

Chaque couleur est traitée par ces lignes :

If c.Interior.ColorIndex = 3 Then
c.EntireRow.Copy Sheets("Négatif").Range("A65535").End(xlUp).Offset(1, 0)
Exit For
End If

If c.Interior.ColorIndex = 3 reprèsente le code de la couleur traitée
(ici
le 3 pour le rouge)

Sheets("Négatif") est le nom de l'onglet de destination

Si tu souhaites rajouter des couleurs tu prends un exemple de ces lignes
que
tu recopies avant le Next de la fin
Puis tu adaptes le code couleur et le nom de l'onglet de destination

Pour connaître le code couleur tu colories une cellule de cette couleur
et
aprés l'avoir sélectionné tu exécutes la macro suivante (aprés l'avoir
créée):

MsgBox (ActiveCell.Interior.ColorIndex)


Une boîte de dialogue te donneras le code couleur de cette cellule

Tu peux aussi modifier les lignes existantes dans ce code en fonction
d'une
nouvelle couleur ou d'un nouveau nom d'onglet

Je suppose qu'une seule couleur sera à traiter par fichier
Dans le cas contraire si plusieurs couleurs par fichier devaient être
recopiées dans les onglets appropriés il faudrait ihniber les ligne "Exit
For" en mettant une cote devant ainsi :

'Exit For

Ou les supprimer

Je te joint un exemple sur ce lien :

http://www.cijoint.fr/cjlink.php?file=cj200807/cij3ViDvH2.xls.

Fais des essais et dis moi !!!!





Péhemme
Le #14483301
Re Bonjour,

Le fichier de FFO te permet de recopier chaque ligne colorée dans un onglet
différent (chaque couleur correspondant à une affectation).
La macro nécessite deux légères modifications :
1°) comme je te le disais dans mon précédent message (ainsi que FFO dans son
message d'envoi du fichier) : mettre une ' devant chaque Exit For.
En effet, ainsi écrite la macro se terminera dès qu'elle aura trouvé et
recopié la première ligne colorée.
2°) tu devras adapter cette macro sur la ligne correspondant aux lignes
concernant "Losc" et "Braderie" traitant de la même couleur 42.

Mais je ne comprends peut-être pas la question

Michel




"romeo59181" news:
Bonjour,

Le tri ne effectue pas ...

Lorsque j'execute la macro la fenetre s'en va mais le tri ne se fait pas
...

Que faire,

Veut tu mon fichier ? Mon tél ?

@+

Romeo59181

"FFO" discussion :
Rebonjour à toi

Pour créer une Macro dans ton fichier:

Outil/Macro/Nouvelle macro
Nom de la macro : mettre un nom
Ok
Cliques sur le carré bleu de l'icone "Arr"
Puis
Outil/Macro/Macros
Sélectionnes le nom de ta macro
Modifier

Entre le Sub et le End Sub mets ces lignes :

For Each c In Worksheets("Feuil1").Range("A1", "A" &
Worksheets("Feuil1").Range("A65535").End(xlUp).Row)
If c.Interior.ColorIndex = 3 Then
c.EntireRow.Copy Sheets("Négatif").Range("A65535").End(xlUp).Offset(1, 0)
Exit For
End If
If c.Interior.ColorIndex = 6 Then
c.EntireRow.Copy Sheets("Manque de
données").Range("A65535").End(xlUp).Offset(1, 0)
Exit For
End If
If c.Interior.ColorIndex = 5 Then
c.EntireRow.Copy Sheets("Portable").Range("A65535").End(xlUp).Offset(1,
0)
Exit For
End If
If c.Interior.ColorIndex = 46 Then
c.EntireRow.Copy Sheets("A Rap").Range("A65535").End(xlUp).Offset(1, 0)
Exit For
End If
If c.Interior.ColorIndex = 15 Then
c.EntireRow.Copy Sheets("A Rap Avec
Date").Range("A65535").End(xlUp).Offset(1, 0)
Exit For
End If
If c.Interior.ColorIndex = 42 Then
c.EntireRow.Copy Sheets("Losc").Range("A65535").End(xlUp).Offset(1, 0)
c.EntireRow.Copy Sheets("Braderie").Range("A65535").End(xlUp).Offset(1,
0)
Exit For
End If
If c.Interior.ColorIndex = 7 Then
c.EntireRow.Copy Sheets("Braderie").Range("A65535").End(xlUp).Offset(1,
0)
Exit For
End If
Next

Chaque couleur est traitée par ces lignes :

If c.Interior.ColorIndex = 3 Then
c.EntireRow.Copy Sheets("Négatif").Range("A65535").End(xlUp).Offset(1, 0)
Exit For
End If

If c.Interior.ColorIndex = 3 reprèsente le code de la couleur traitée
(ici
le 3 pour le rouge)

Sheets("Négatif") est le nom de l'onglet de destination

Si tu souhaites rajouter des couleurs tu prends un exemple de ces lignes
que
tu recopies avant le Next de la fin
Puis tu adaptes le code couleur et le nom de l'onglet de destination

Pour connaître le code couleur tu colories une cellule de cette couleur
et
aprés l'avoir sélectionné tu exécutes la macro suivante (aprés l'avoir
créée):

MsgBox (ActiveCell.Interior.ColorIndex)


Une boîte de dialogue te donneras le code couleur de cette cellule

Tu peux aussi modifier les lignes existantes dans ce code en fonction
d'une
nouvelle couleur ou d'un nouveau nom d'onglet

Je suppose qu'une seule couleur sera à traiter par fichier
Dans le cas contraire si plusieurs couleurs par fichier devaient être
recopiées dans les onglets appropriés il faudrait ihniber les ligne "Exit
For" en mettant une cote devant ainsi :

'Exit For

Ou les supprimer

Je te joint un exemple sur ce lien :

http://www.cijoint.fr/cjlink.php?file=cj200807/cij3ViDvH2.xls.

Fais des essais et dis moi !!!!





romeo59181
Le #14479171
Bonjour,

Voici le lien :
http://www.cijoint.fr/cjlink.php?file=cj200807/cij2Zvzpam.xls

En ce qui concerne l'objectif voulu il est simple :

Chaque ligne colorée doit aller automatiquement sous le bon onglet en
fonction de la couleur et de la légende jointe au fichier ...

Espérant avoir été plus clair,

Romeo59181

"FFO" discussion :
Rebonjours à toi

Je t'ai transmis un code pour recopier des lignes colorées non pas pour
exécuter un tri
J'ai du mal à comprendre ton attente

Tu peux me transmettre ton fichier par le biais de ce site :

http://www.cijoint.fr/index.php

Communiques moi le lien pour le récupérer ainsi que toutes les
explications
nécessaire à l'objectif souhaité

Merci



romeo59181
Le #14479161
Bonjour,

Démarche effectuée mais toujours le même résultat ...

D'autre pistes ?

Romeo59181

"Péhemme"
Bonjour,

Retire les Exit For (mets un ' devant) de chaque If Then

Michel

"romeo59181" news:
Bonjour,

Le tri ne effectue pas ...

Lorsque j'execute la macro la fenetre s'en va mais le tri ne se fait pas
...

Que faire,

Veut tu mon fichier ? Mon tél ?

@+

Romeo59181

"FFO" de discussion :
Rebonjour à toi

Pour créer une Macro dans ton fichier:

Outil/Macro/Nouvelle macro
Nom de la macro : mettre un nom
Ok
Cliques sur le carré bleu de l'icone "Arr"
Puis
Outil/Macro/Macros
Sélectionnes le nom de ta macro
Modifier

Entre le Sub et le End Sub mets ces lignes :

For Each c In Worksheets("Feuil1").Range("A1", "A" &
Worksheets("Feuil1").Range("A65535").End(xlUp).Row)
If c.Interior.ColorIndex = 3 Then
c.EntireRow.Copy Sheets("Négatif").Range("A65535").End(xlUp).Offset(1,
0)
Exit For
End If
If c.Interior.ColorIndex = 6 Then
c.EntireRow.Copy Sheets("Manque de
données").Range("A65535").End(xlUp).Offset(1, 0)
Exit For
End If
If c.Interior.ColorIndex = 5 Then
c.EntireRow.Copy Sheets("Portable").Range("A65535").End(xlUp).Offset(1,
0)
Exit For
End If
If c.Interior.ColorIndex = 46 Then
c.EntireRow.Copy Sheets("A Rap").Range("A65535").End(xlUp).Offset(1, 0)
Exit For
End If
If c.Interior.ColorIndex = 15 Then
c.EntireRow.Copy Sheets("A Rap Avec
Date").Range("A65535").End(xlUp).Offset(1, 0)
Exit For
End If
If c.Interior.ColorIndex = 42 Then
c.EntireRow.Copy Sheets("Losc").Range("A65535").End(xlUp).Offset(1, 0)
c.EntireRow.Copy Sheets("Braderie").Range("A65535").End(xlUp).Offset(1,
0)
Exit For
End If
If c.Interior.ColorIndex = 7 Then
c.EntireRow.Copy Sheets("Braderie").Range("A65535").End(xlUp).Offset(1,
0)
Exit For
End If
Next

Chaque couleur est traitée par ces lignes :

If c.Interior.ColorIndex = 3 Then
c.EntireRow.Copy Sheets("Négatif").Range("A65535").End(xlUp).Offset(1,
0)
Exit For
End If

If c.Interior.ColorIndex = 3 reprèsente le code de la couleur traitée
(ici
le 3 pour le rouge)

Sheets("Négatif") est le nom de l'onglet de destination

Si tu souhaites rajouter des couleurs tu prends un exemple de ces lignes
que
tu recopies avant le Next de la fin
Puis tu adaptes le code couleur et le nom de l'onglet de destination

Pour connaître le code couleur tu colories une cellule de cette couleur
et
aprés l'avoir sélectionné tu exécutes la macro suivante (aprés l'avoir
créée):

MsgBox (ActiveCell.Interior.ColorIndex)


Une boîte de dialogue te donneras le code couleur de cette cellule

Tu peux aussi modifier les lignes existantes dans ce code en fonction
d'une
nouvelle couleur ou d'un nouveau nom d'onglet

Je suppose qu'une seule couleur sera à traiter par fichier
Dans le cas contraire si plusieurs couleurs par fichier devaient être
recopiées dans les onglets appropriés il faudrait ihniber les ligne
"Exit
For" en mettant une cote devant ainsi :

'Exit For

Ou les supprimer

Je te joint un exemple sur ce lien :

http://www.cijoint.fr/cjlink.php?file=cj200807/cij3ViDvH2.xls.

Fais des essais et dis moi !!!!








romeo59181
Le #14479151
Bonjour,

Démarche effectuée mais toujours le même résultat ...

D'autre pistes ?

Romeo59181

"Péhemme"
Re Bonjour,

Le fichier de FFO te permet de recopier chaque ligne colorée dans un
onglet différent (chaque couleur correspondant à une affectation).
La macro nécessite deux légères modifications :
1°) comme je te le disais dans mon précédent message (ainsi que FFO dans
son message d'envoi du fichier) : mettre une ' devant chaque Exit For.
En effet, ainsi écrite la macro se terminera dès qu'elle aura trouvé et
recopié la première ligne colorée.
2°) tu devras adapter cette macro sur la ligne correspondant aux lignes
concernant "Losc" et "Braderie" traitant de la même couleur 42.

Mais je ne comprends peut-être pas la question

Michel




"romeo59181" news:
Bonjour,

Le tri ne effectue pas ...

Lorsque j'execute la macro la fenetre s'en va mais le tri ne se fait pas
...

Que faire,

Veut tu mon fichier ? Mon tél ?

@+

Romeo59181

"FFO" de discussion :
Rebonjour à toi

Pour créer une Macro dans ton fichier:

Outil/Macro/Nouvelle macro
Nom de la macro : mettre un nom
Ok
Cliques sur le carré bleu de l'icone "Arr"
Puis
Outil/Macro/Macros
Sélectionnes le nom de ta macro
Modifier

Entre le Sub et le End Sub mets ces lignes :

For Each c In Worksheets("Feuil1").Range("A1", "A" &
Worksheets("Feuil1").Range("A65535").End(xlUp).Row)
If c.Interior.ColorIndex = 3 Then
c.EntireRow.Copy Sheets("Négatif").Range("A65535").End(xlUp).Offset(1,
0)
Exit For
End If
If c.Interior.ColorIndex = 6 Then
c.EntireRow.Copy Sheets("Manque de
données").Range("A65535").End(xlUp).Offset(1, 0)
Exit For
End If
If c.Interior.ColorIndex = 5 Then
c.EntireRow.Copy Sheets("Portable").Range("A65535").End(xlUp).Offset(1,
0)
Exit For
End If
If c.Interior.ColorIndex = 46 Then
c.EntireRow.Copy Sheets("A Rap").Range("A65535").End(xlUp).Offset(1, 0)
Exit For
End If
If c.Interior.ColorIndex = 15 Then
c.EntireRow.Copy Sheets("A Rap Avec
Date").Range("A65535").End(xlUp).Offset(1, 0)
Exit For
End If
If c.Interior.ColorIndex = 42 Then
c.EntireRow.Copy Sheets("Losc").Range("A65535").End(xlUp).Offset(1, 0)
c.EntireRow.Copy Sheets("Braderie").Range("A65535").End(xlUp).Offset(1,
0)
Exit For
End If
If c.Interior.ColorIndex = 7 Then
c.EntireRow.Copy Sheets("Braderie").Range("A65535").End(xlUp).Offset(1,
0)
Exit For
End If
Next

Chaque couleur est traitée par ces lignes :

If c.Interior.ColorIndex = 3 Then
c.EntireRow.Copy Sheets("Négatif").Range("A65535").End(xlUp).Offset(1,
0)
Exit For
End If

If c.Interior.ColorIndex = 3 reprèsente le code de la couleur traitée
(ici
le 3 pour le rouge)

Sheets("Négatif") est le nom de l'onglet de destination

Si tu souhaites rajouter des couleurs tu prends un exemple de ces lignes
que
tu recopies avant le Next de la fin
Puis tu adaptes le code couleur et le nom de l'onglet de destination

Pour connaître le code couleur tu colories une cellule de cette couleur
et
aprés l'avoir sélectionné tu exécutes la macro suivante (aprés l'avoir
créée):

MsgBox (ActiveCell.Interior.ColorIndex)


Une boîte de dialogue te donneras le code couleur de cette cellule

Tu peux aussi modifier les lignes existantes dans ce code en fonction
d'une
nouvelle couleur ou d'un nouveau nom d'onglet

Je suppose qu'une seule couleur sera à traiter par fichier
Dans le cas contraire si plusieurs couleurs par fichier devaient être
recopiées dans les onglets appropriés il faudrait ihniber les ligne
"Exit
For" en mettant une cote devant ainsi :

'Exit For

Ou les supprimer

Je te joint un exemple sur ce lien :

http://www.cijoint.fr/cjlink.php?file=cj200807/cij3ViDvH2.xls.

Fais des essais et dis moi !!!!








Publicité
Poster une réponse
Anonyme