Copie de ligne en fonction de couleur de cellule dans d'autre feuille

bobn85@hotmail.fr

XLDnaute Nouveau
Bonjour, grace a vous mon fichier bien avancé
j'aimerai pouvoir le faire évoluer encore un peu + avec 2 choses en supp.
je m'explique :
1er point
feuil1 : si le mot "atelier" est présent dans la colonnes C la ligne si référent est copié dans la feuille atelier
exemple : en C25 : "atelier" présent donc la ligne 25 sera copié dans la feuil atelier
2nd point
selon la couleur en A : copie de la ligne A dans les diverses feuilles:
devis a faire = rouge
devis fait = orange
attente piece = bleu
piece recu = violet
cloture = vert
exemple : A3 =vert donc ligne 3 copié dans la feuille cloturé
Si la couleur change dans la colonne A de la feuil1 les lignes copiés de la feuil1 dans les autres feuilles doivent se supprimer pour se copier dans la bonne feuille.

merci d'avance
 

Pièces jointes

  • SUIVI JOURNALIER - Copie.xlsm
    176.4 KB · Affichages: 335
  • SUIVI JOURNALIER - Copie.xlsm
    176.4 KB · Affichages: 368
  • SUIVI JOURNALIER - Copie.xlsm
    176.4 KB · Affichages: 385

CHALET53

XLDnaute Barbatruc
Re : Copie de ligne en fonction de couleur de cellule dans d'autre feuille

Bonjour,

les couleurs de la colonne A sont mises à partir de mise en forme conditionnelle
Elles ne sont pas reconnues en VBA (il me semble et j'ai été confronté au problème) : donc difficile d'exploiter la couleur
Il faut trouver une autre solution pour exploiter les différents cas : une colonne supplémentaire avec une valeur appropriée à chaque cas

A suivre
 

klin89

XLDnaute Accro
Re : Copie de ligne en fonction de couleur de cellule dans d'autre feuille

Bonjour le forum, CHALET53, bobn85

Pour palier au problème souligné par CHALET53
On pourrait, dans un 1er temps, supprimer la MFC appliquée à la colonne A de la Feuil1.

Ce lien n'existe plus

Et la remplacer par cette macro de mise en forme.
VB:
Sub MiseEnForme_ColonneA()
Dim cel As Range
Application.ScreenUpdating = False
With Sheets("Feuil1")
For Each cel In Range("A3:A" & [A65536].End(xlUp).Row)
  If cel.Offset(0, 21) = "" Then
    If cel.Offset(0, 19) = "" Then
      If cel.Offset(0, 17) = "" Then
        cel.Interior.ColorIndex = xlNone 'pas de mise en forme
      Else
        cel.Interior.ColorIndex = 10 'vert
      End If
    Else
        cel.Interior.ColorIndex = 13 'violet
    End If
  Else
    cel.Interior.ColorIndex = 10 'vert
  End If
Next cel
Range("a3").Select
Application.ScreenUpdating = True
End With
End Sub

Puis en venir à traiter le 2ème point de ta question, à savoir ventiler tes données en fonction des couleurs appliquées en colonne A.

Là, je ne saisis pas vraiment ton souhait :rolleyes:
Il n'y a que 3 possibilités d'affichage de couleurs en colonne A donc comment ventiler tes données dans toutes tes feuilles en fonction de ce seul critère de la colonne A.

selon la couleur en A : copie de la ligne A dans les diverses feuilles:
devis a faire = rouge
devis fait = orange
attente piece = bleu
piece recu = violet
cloture = vert
exemple : A3 =vert donc ligne 3 copié dans la feuille cloturé

Y a quelque chose qui m'échappe :confused:

Klin89
 

bobn85@hotmail.fr

XLDnaute Nouveau
Re : Copie de ligne en fonction de couleur de cellule dans d'autre feuille

merci pour votre aide (CHALET53, klin89, le forum)
je vous donne un peu plus d'explication sur le fonctionnement du fichier
la page Feuil1 est un tableau de bord qui est rempli manuellement sous excel2007 et 2010.
en fonction du clique dans les colonnes en J L M O Q R T V la couleur est inscrite en A.
ce qui me permet d'avoir un visuel rapide de la ligne par rapport a la couleur en A. ( rose, rouge,orange,bleu,violet,vert)
exemple si je clique sur J la couleur en A sera rose donc je sais que c'est une planification etc selon la case cliqué
ceci marche très bien et ce grâce a vous.

je voudrais pouvoir classer dans d'autres feuilles les lignes selon leur couleur: rose, rouge,orange,bleu,violet,vert. (bouton activeX?)
j'espère que c'est un peu plus clair.
Merci
 

Pièces jointes

  • Copie de ligne.xlsm
    207 KB · Affichages: 324
  • Copie de ligne.xlsm
    207 KB · Affichages: 360
  • Copie de ligne.xlsm
    207 KB · Affichages: 338

bobn85@hotmail.fr

XLDnaute Nouveau
Re : Copie de ligne en fonction de couleur de cellule dans d'autre feuille

voici le fichier mise a jour.
la macro de la de klin89 est sous excel 2003 d'ou 3 conditions; sous 2007 et 2010 il y + de conditions es-ce possible d'adapter le code?
merci.
 

Pièces jointes

  • Copie de ligne.xlsm
    213.8 KB · Affichages: 352
  • Copie de ligne.xlsm
    213.8 KB · Affichages: 319
  • Copie de ligne.xlsm
    213.8 KB · Affichages: 301

klin89

XLDnaute Accro
Re : Copie de ligne en fonction de couleur de cellule dans d'autre feuille

Bonsoir à tous,

Rappel : les cellules fusionnées engendre le bazar :p

Sinon un essai, en considérant que la couleur de fond des cellules de la colonne A (Feuil1) ne provienne pas d'une MFC, sinon ça ne marche pas :rolleyes:

Y a sûrement mieux à faire.

VB:
Sub Recopier_Selon_Couleur_ColonneA()
Dim n As Long, derlig As Long, feuil As String, colori As Integer
For n = 3 To Range("A65536").End(xlUp).Row
  'On définit la Couleur de fond de la cellule
  colori = Range("A" & n).Interior.ColorIndex
  Select Case colori
  
    Case 10 'Vert
    'Si Vert, ventiler dans la feuille "cloturé"
      feuil = "cloturé"
      derlig = Sheets(feuil).Range("A65536").End(xlUp).Row + 1
      'cette ligne à cause de la cellule fusionnée en en-tête
      If derlig = 2 Then derlig = 3
      Range("A" & n & ":AL" & n).Copy Destination:=Sheets(feuil).Cells(derlig, 1)
      
    Case 13 'Violet
    'Si Violet, ventiler dans la feuille "piece recu"
      feuil = "piece recu"
      derlig = Sheets(feuil).Range("A65536").End(xlUp).Row + 1
      If derlig = 2 Then derlig = 3
      Range("A" & n & ":AL" & n).Copy Destination:=Sheets(feuil).Cells(derlig, 1)
      
    Case -4142 'Pas de couleur
    'Si Pas de couleur, ventiler dans la feuille "devis a faire"
      feuil = "devis a faire"
      derlig = Sheets(feuil).Range("A65536").End(xlUp).Row + 1
      If derlig = 2 Then derlig = 3
      Range("A" & n & ":AL" & n).Copy Destination:=Sheets(feuil).Cells(derlig, 1)
      
  End Select
Next n
End Sub

Edit : le code reste perfectible, car les lignes 49 à 63 de Feuil1 ne sont pas recopiées dans la feuille "cloturé" parce que l'on s'appuie sur la colonne A.
[A49:A63] sont des cellules vides
derlig = Sheets(feuil).Range("A65536").End(xlUp).Row + 1

En fait, elles sont copiées mais aussitôt écrasées car derlig ne s'incrémente plus :(

Klin89
 
Dernière édition:

klin89

XLDnaute Accro
Re : Copie de ligne en fonction de couleur de cellule dans d'autre feuille

Bonjour le forum,

Dans le code du post #6#, remplace :
Code:
derlig = Sheets(feuil).Range("A65536").End(xlUp).Row + 1
par ceci :
Code:
derlig = Sheets(feuil).Cells.Find("*", , , , xlByRows, xlPrevious).Row + 1

et supprime cela :
VB:
'cette ligne à cause de la cellule fusionnée en en-tête
     'If derlig = 2 Then derlig = 3

Ça devrait le faire, à tester.

Klin89
 

bobn85@hotmail.fr

XLDnaute Nouveau
Re : R

merci a tous votre aide mais il me reste un point a solutionner.
j'ai appliqué le code de :
klin89 pour appliquer des couleurs en VBA dans la colonnes A = ok

CHALET53 pour copier les ligne comportant le mot atelier dans d'autres feuille = ok

klin89 pour copier les lignes selon la couleur de la colonnes A dans d'autres feuilles:
les lignes des feuille devis a faire, devis fait et blanc ne se copie pas
le probleme est que les copies qui marche (pièce en commande, piece recu, cloturé) s'incrémente dans les feuilles. si je clique plusieurs fois sur le bouton MAj (macro) je me retrouve avec beaucoup de doublon sur la meme feuille.
et si la couleur a changé dans la colonne A feuil1 les lignes copiés ne sont pas mise a jour dans les autres feuilles.
voir fichier en PJ
merci
 

Pièces jointes

  • Copie de ligne - Copie.zip
    261.8 KB · Affichages: 228
  • Copie de ligne - Copie.zip
    261.8 KB · Affichages: 239
  • Copie de ligne - Copie.zip
    261.8 KB · Affichages: 271
Dernière édition:

klin89

XLDnaute Accro
Re : Copie de ligne en fonction de couleur de cellule dans d'autre feuille

Bonsoir à tous,

Je vois que tu n'as pas tenu compte de ma remarque du post #7#
A l'usage, il se peut que le résultat souhaité s'en trouve faussé (voir mes propos du post #6#)
Sinon, dans Case 3, tu as oublié quelque chose non :rolleyes:

VB:
Case 3 'rouge
      'Si rouge, ventiler dans la feuille "devis a faire"
      feuil = "devis a faire"
      derlig = Sheets(feuil).Range("A65536").End(xlUp).Row + 1
      If derlig = 2 Then derlig = 3
      Range("A" & n & ":AL" & n).Copy Destination:=Sheets(feuil).Cells(derlig, 1)

On pourrait aussi rajouter cette macro qui passe en revue toutes tes feuilles sauf celle nommée Feuil1 et qui efface tes données précédemment copiées.

VB:
Sub Effacement()
Dim Ws As Worksheet
Application.EnableEvents = False
For Each Ws In ThisWorkbook.Worksheets
    If Ws.Name <> "Feuil1" Then
        Sheets(Ws.Name).Range("A3:AL" & Sheets(Ws.Name).Range("A65536").End(xlUp).Row).Delete
    End If
    Next
Application.EnableEvents = True
End Sub

Que l'on appellerait ici :

VB:
Private Sub CommandButton1_Click()
Call MiseEnForme_ColonneA
Call Effacement
Call Atelier
Call Recopier_Selon_Couleur_ColonneA
End Sub

Ce qui te permettrait de faire les mises à jour de tes différentes feuilles.
Enfin, je vois les choses comme ça.

A tester et retester dans la configuration du fichier présenté évidemment.

Klin89
 
Dernière édition:

VINCE6945

XLDnaute Nouveau
Re : Copie de ligne en fonction de couleur de cellule dans d'autre feuille

Bonjours je me demande si quelqu'un pourrait m'aider à résoudre un problème. Je dois copier certaines cases d'une ligne lorsqu'on retrouve "nom de la personne" Dans 2 fichier différent. unnamed.jpg
 

Discussions similaires

Statistiques des forums

Discussions
312 356
Messages
2 087 561
Membres
103 590
dernier inscrit
Picsou74