Copie de ligne suivant couleur

Résolu
O2b Messages postés 6 Statut Membre -  
lermite222 Messages postés 9042 Statut Contributeur -
Bonjour,

Hé oui, voila déjà une deuxième question. Dans un tableau excel, j'ai des lignes avec trois couleurs différentes (rouge, jaune et vert).
Je souhaiterais programmer une petite macro permettant de recopier les lignes rouges dans une autre feuille "Correctif", les lignes jaunes dans une autre feuille (HC) et les lignes vertes dans une autre feuille "Préventif".
Toutes ces feuilles se trouvent dans le même classeur Excel.

Merci d'avance,

Cordialement,

O2b,
Configuration: Windows XP
Internet Explorer 6.0

7 réponses

  1. lermite222 Messages postés 9042 Statut Contributeur 1 199
     
    Bonjour,
    Tu veux faire ça sur commande ou en automatique ?
    A+
    0
  2. michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
     
    Bonjour tous les 2

    Les colueurs sont elles implantées manuellement ou par conditions automatiques macro ou MEFC ?
    0
    1. lermite222 Messages postés 9042 Statut Contributeur 1 199
       
      Salut michel,
      Il ne me viendrais surtout pas à l'idée de changer un c par un p :-DDD---- :-))
      A+
      0
    2. O2b
       
      Bonjour,

      Hé bien les couleurs sont automatiquement misent par macro.
      En ce qui concerne la nouvelle macro si ca se fai automatiquement c'est peut être mieux maintenant avec un bouton c est sûrement plus fiable surtout si on n'est amené à effacer ou à réécrire une ligne.

      Cdt,

      O2b
      0
  3. michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
     
    hé oui! Parkinson a encore frappé!
    0
  4. lermite222 Messages postés 9042 Statut Contributeur 1 199
     
    Re,
    Voila déja une macro qui copies les lignes comme demander.
    Je n'ai pas su la tester vu que je n'ai pas ton classeur.
    Les couleurs sont peut-être à adapter suivant celles que tu a sélectionner.
    Tu colle la macro dans UN MODULE GENERAL (par ex: Module1)

    Option Explicit
    'Constantes à adapter en fonction des premières lignes
    'de titre des feuilles
    Const DebTableau = 5
    Const DebCorrectif = 5
    Const DebHC = 5
    Const DebPreventif = 5
    
    Sub AjouteLigne()
    Dim Lig As Long, FinCorrect As Long
    Dim FinHC As Long, FinPrev As Long
        FinCorrect = Sheets("Correctif").Range("A65536").End(xlUp).Row + 1
        If FinCorrect < DebCorrectif Then FinCorrect = DebCorrectif
        
        FinHC = Sheets("HC").Range("A65536").End(xlUp).Row + 1
        If FinHC < DebHC Then FinHC = DebHC
        
        FinPrev = Sheets("HC").Range("A65536").End(xlUp).Row + 1
        If FinPrev < DebPreventif Then FinPrev = DebPreventif
        
        With Sheets("Feuil1") 'Adapter au nom de la feuille
            For Lig = DebTableau To Range("A65536").End(xlUp).Row
                Select Case Cells(Lig, 1).Interior.ColorIndex
                Case 3 'Rouge
                    .Rows(Lig).Copy Sheets("Correctif").Rows(FinCorrect)
                    FinCorrect = FinCorrect + 1
                Case 4 'Vert
                    .Rows(Lig).Copy Sheets("HC").Rows(FinHC)
                    FinHC = FinHC + 1
                Case 6 'Jaune
                    .Rows(Lig).Copy Sheets("Préventif").Rows(FinPrev)
                    FinPrev = FinPrev + 1
                End Select
            Next Lig
        End With
    End Sub

    Probablement quelques modif à faire, tu dit...
    A+
    0
    1. O2b
       
      Bonjour,

      Malheureusement cela ne fonctionne pas. Si encore j'avais des compétences je trouverais sûrement d'où provient l'erreur mais ce n'est pas le cas.Hélas.
      Voila ma macro (qui est la vôtre) de la mise en couleur des lignes :

      Sub Bouton1_Clic()
      Dim c As Range, cellule As Range
      Dim Lig As Byte

      Application.ScreenUpdating = False
      For Each c In ActiveSheet.Range("i1:i200")
      c = UCase(c)
      Lig = c.Row
      Set cellule = Range(Cells(Lig, 1), Cells(Lig, 9))
      Select Case c
      Case "P"
      cellule.Interior.ColorIndex = 4
      Case "C"
      cellule.Interior.ColorIndex = 3
      Case "HC"
      cellule.Interior.ColorIndex = 6
      Case ""
      cellule.Interior.ColorIndex = -4142
      End Select
      Next
      End Sub

      De part cette macro, je voudrais ensuite recopier les lignes rouges dans une feuille Correctif, les lignes vertes dans une feuille Préventif et les lignes jaunes dans une feuille H-c. Je sais pas comment joindre mon fichier. Au mieux je peux vous l'envoyer par mail.

      Aussi je peux mettre à disposition une petite gmao via excel 03. Si cela interesse du monde, faites moi signe. On pourrait donc la modifier. Je n'arriva pas à l'adapter sur excel 07.

      Cdt,

      O2b
      0
  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. wilfried_42 Messages postés 912 Statut Contributeur 245
     
    bonjur à tous

    j'ai survolé la procédure de lermite222 et je ne vois pas ce qui cloche, tout à l'air correct

    alors encore une fois puisque michel t'a deja posé la question, es tu certain que ce n'est pas une MFC qui te mets les couleurs
    pour verifier, tu te mets sur une ligne colorée et tu faits Menu Format / Mises en Forme Conditionnelles
    et regarde si tu obtiens quelque chose
    0
  7. O2b
     
    Non merci ce qui me met les couleurs c est la macro que je cite auparavant. La macro de Lermitte fonctionne peut être dans un classeur vide mais pas dans le mien.

    Merci quand même de tn intervention wilfried
    0
    1. lermite222 Messages postés 9042 Statut Contributeur 1 199
       
      Re,
      Tu a adapter le nom de Feuil1 au nom de ta feuille où il y a le tableau ?
      Les noms des feuilles sont-il exact ?
      Tu a bien mis la macro dans un module ET NON PAS DANS L'APPPEL D'UN BOUTON , ça ira pas.
      Si tu as mis dans un bouton...
      Supprime tout et copie dans Module1.
      Dans l'appel du bouton tu met simplement
      Sub Bouton2_Clic()
          AjouteLigne
      End Sub

      Dit où est l'erreur.. sur quel ligne de code il met une erreur et le message donner.
      Si ça va toujours pas...
      Tu peu poster ton classeur sur Cjoint https://www.cjoint.com/
      Et donner le lien sur un poste suivant.
      En 2003 si possible siinon je doit faire de la gymnastique entre mes PC.
      A+
      0
      1. O2b Messages postés 6 Statut Membre > lermite222 Messages postés 9042 Statut Contributeur
         
        Bonjour,

        Merci pour tes réponses, cela fonctionne correctement, j'avais commis quelques erreurs de frappe. Sinon le lien cijoint ne fonctionne pas sur mon poste (je suis sur mon lieu de travail, celui-ci est sûrement bloqué).
        Je peux t'envoyer une gmao sous excel 2003 si cela t'interesse. Elle fonctionne correctement, le seul "hic" c'est que je n'arrive pas à l'adapter sur excel 07 à part ca le programme est interessant et complet. A vous de me dire.

        Encore merci

        Cdt,

        O2b,
        0
  8. lermite222 Messages postés 9042 Statut Contributeur 1 199
     
    Re,
    Tant mieux que ça ai fonctionné.
    Je ne sais pas ce que gmao veux dire ?
    A+
    0