Copie Ligne suivant couleur texte

[Aladin]

Bonjour le forum
J' ai cherché dans les pots et n' ai pas trouvé exactement une réponse à mon pb. Je voudrais copié des lignes de la colonne A sur une autre feuille mais qui réponde à la condition de couleur de texte noir, car l' entete es en bleu et les sous entetes en rouge
Meci d' avance pour toure réponse
Aladin

 

[Aladin]

Re : Copie Ligne suivant couleur texte

Bonsoit JNP et le forum
J' ai fais les modif et le code fonctionne aléatoirement, certain moment il recupre les donnes et d' autres fois il ne recupre rien du tout.
JNP y a t- il une solution pour optimisé le code
Merci d' avance

Aladin

 

[Lii]

Re : Copie Ligne suivant couleur texte

Bonjour.

2 remarques :
pour la colonne B c'est Cells(x,2) ou Cells(x,"B")
pour la couleur de la police c'est 1 pour le noir ou -4105 pour l'automatique donc uniformiser ou prévoir les 2 tests
A tester

Sub btnOK()

  [COLOR=Blue]Dim I As Byte
  Dim Li As Long
  Dim Cel As Range
[/COLOR]
  Application.ScreenUpdating = False
  For I = 0 To LbFeuilles.ListCount - 1
    If LbFeuilles.Selected(I) = True Then
      Application.StatusBar = "Exportation: " & LbFeuilles.List(I)
      [COLOR=Blue]Li= 1 [COLOR=Olive]'à voir[/COLOR]
      With Sheets(LbFeuilles.List(I))
        For Each Cel In [B].[/B]Range("A1:A" & [B].[/B]Range("32000").End(xlUp).Row)
          If Not IsEmpty(Cel) Then
            If Cel.Font.ColorIndex = -4105 Then
              Li = Li + 1
              Cel.Copy Sheets("Data-Globale").Cells(Li, "B") [COLOR=Olive] [B]'Colonne B[/B][/COLOR]
            End If
          Next
        Next
      End With[/COLOR]
      'Sheets(LbFeuilles.List(i)).PrintPreview
    End If
  Next I
  Unload Me
  FrmInterface.Hide
  Application.StatusBar = False
  Application.ScreenUpdating = True
End Sub

 

[JNP]

Re : Copie Ligne suivant couleur texte

Re 🙂,
Comme dit Lii et préconisé par mon post du 15/09/2009, 16h34, il vaut mieux utiliser un Or pour tenir compte du 1 ou du -4105 😉.
Bonne soirée 😎

 

[Aladin]

Re : Copie Ligne suivant couleur texte

Bonjour JNP et le forum
Malgré la modif faite avec With, le test est négatif, merci d' avance pour ton aide
Aladin

 

[JNP]

Re : Copie Ligne suivant couleur texte

Re 🙂,
As-tu bien remis

If .Cells(I, 1).Font.ColorIndex = -4105[COLOR=red][B] [COLOR=red]Or [/COLOR][/B][/COLOR][COLOR=#000000][B][COLOR=red].Cells(I, 1).Font.ColorIndex = 1[/COLOR][/B] Then[/COLOR]

sinon, reposte ton fichier dernière version avec les macros (sans données confidentielles) que l'on puisse faire des tests.
Bon WE 😎

 

[Lii]

Re : Copie Ligne suivant couleur texte

Re,

Aladin, t'es radin en remerciements ? 😡

 

[Aladin]

Re : Copie Ligne suivant couleur texte

Bonjour Lii, JNP et le forum

Non Lii, je ne suis pas avare en remerciements, mon tort c' est de n' avoir pas vu la deuxieme page du post car je n' etait pas concentré sur le sujet, c'est pour cela aussi que je n' ai pas fait les test de la deuxieme page.
Demain je ferai les tests et vous tiendrai au courant du resultat
Merci a vous deux pour vos reponses
Aladin