XL pour MAC Récupérer l'ensemble des lignes de couleur X dans un onglet

  • Initiateur de la discussion Initiateur de la discussion BilalD
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

BilalD

XLDnaute Nouveau
Bonjour,

Je suis confronté à un tableau d'un comptable que j'essai de simplifier.
Chaque onglet du tableau correspond à un service de l'entreprise et des frais réalisés par ce service, le comptable a mis une couleur de police rouge pour les factures manquantes et que l'on doit lui envoyer.

J'aurai voulu créer un nouvel onglet qui regroupe toutes les lignes en rouge (une ligne = 3 colonnes : le service concerné, la date et le montant).

Je n'ai pas trouvé de moyen de faire cela avez vous une idée ?

Merci pour votre aide
 
@Phil69970 j'abuse de ton aide, mais comment je peux faire pour que d'autres feuilles soient prises en compte ?
Le fichier que j'ai envoyé était un échantillon, le vrai comporte une dizaine de feuille.

je n'ai pas trouvé ou cela se gère dans la macro


VB:
Sub Copie()
Application.ScreenUpdating = False

Dim WsDst As Worksheet, Ws As Worksheet, DerligDst&, Derlig&, i&

Set WsDst = Worksheets("Synthèse")
DerligDst = WsDst.Range("B" & Rows.Count).End(xlUp).Row + 1
WsDst.Range("B4:E" & DerligDst).ClearContents
DerligDst = WsDst.Range("B" & Rows.Count).End(xlUp).Row + 1

For Each Ws In Worksheets
    With Ws
        If .Name <> "Synthèse" Then
            Derlig = .Range("A" & Rows.Count).End(xlUp).Row
            For i = 4 To Derlig
                If .Range("A" & i).Font.ColorIndex = 3 Then
                    WsDst.Range("B" & DerligDst & ":E" & DerligDst) = .Range("A" & i & ":D" & i).Value
                    DerligDst = WsDst.Range("B" & Rows.Count).End(xlUp).Row + 1
                End If
            Next i
        End If
    End With
Next Ws
Set WsDst = Nothing
End Sub
 
Bonsoir le fil

Histoire de varier les plaisirs
(et pour la curiosité de savoir si cela fonctionne sur Excel Mac)
Une macro qui utilise le filtre automatique
VB:
Sub Copier_par_Filtre_Couleur()
Dim ws As Worksheet
For Each ws In Worksheets
    If ws.Name <> "Synthèse" Then
        ws.[A3].CurrentRegion.AutoFilter Field:=1, Criteria1:=RGB(255, 0, 0), Operator:=xlFilterFontColor
        With ws.AutoFilter.Range
        Set rngF = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).SpecialCells(xlCellTypeVisible)
        End With
        rngF.Copy Sheets("Synthèse").Cells(Rows.Count, "B").End(3)(2)
        ws.AutoFilterMode = False
    End If
Next
End Sub
 
Une version paramétrable
(on peut choisir la couleur)
Fonctionne sur la base du fichier exemple
(tous les tableaux commencent toujours en A3 sur les feuilles à traiter)
VB:
Sub Traitement()
'ici on peut choisir la couleur
'ici: rouge
Copie_Couleur vbRed
End Sub
Private Sub Copie_Couleur(couleur)
Dim ws As Worksheet
For Each ws In Worksheets
If ws.Name <> "Synthèse" Then
ws.[A3].CurrentRegion.AutoFilter 1, couleur, 9
Set rngF = ws.AutoFilter.Range.Offset(1, 0).Resize(ws.AutoFilter.Range.Rows.Count - 1, ws.AutoFilter.Range.Columns.Count).SpecialCells(12)
rngF.Copy Sheets("Synthèse").Cells(Rows.Count, "B").End(3)(2): ws.AutoFilterMode = 0
End If
Next
End Sub
 
Bonjour à tous 😉,

Surtout pour vous saluer, une autre version (avec commentaires) :
VB:
Sub QueLesRouges()
Dim sh, n&, der&, i&, j&, f
  
   For Each sh In Worksheets     'calcul d'un majorant n du nombre de lignes du tableau résultat
      If sh.Name <> Sheets("Synthèse").Name Then n = n + sh.UsedRange.Rows.Count
   Next sh
   ReDim t(1 To n, 1 To 4): n = 0      'déclaration et dimmensionnement du tableau résultat
   For Each sh In Worksheets           'pour chaque feuille de calcul
      If sh.Name <> Sheets("Synthèse").Name Then   'seulement si on ne traite pas la feuille "Synthèse"
         With sh                                   'avec la feuille qu'on traite
            If .FilterMode Then .ShowAllData       'si filtre, on affiche tout - pour bon fonctionnement de End(xlup)
            der = .Cells(Rows.Count, "a").End(xlUp).Row  'dernière ligne de données de la la feuille sh
            If der >= 4 Then                             'si il y a au moins une ligne source
               f = .Range("a4:d" & der)                  'on lit le tableau source de sh
               For i = 1 To UBound(f)                    'boucle sur le tableau source
                  'si la police est rouge, on recopie la ligne source (depuis f) dans la ligne suivante du tableau résultat (t)
                  If .Cells(3 + i, "a").Font.Color = vbRed Then: n = n + 1: For j = 1 To 4: t(n, j) = f(i, j): Next
               Next i
            End If
         End With
      End If
   Next sh
   Application.ScreenUpdating = False                    'on fige l'affichage (plus rapide)
   With Sheets("Synthèse")                               'avec la feuille "Synthèse"
      .Activate                                          'on active la feuille
      If .AutoFilterMode Then Cells.AutoFilter           'si autofiltre, on l'enlève
      .Range("b5:e" & Rows.Count).Clear                  'on efface les résultats précédents (ligne 5 à la dernière ligne)
      .Range("b5").Resize(n, 4) = t                      'on transfère les n premières lignes résultats de t sur la feuille
      .Range("d5").Resize(n).NumberFormat = "# ##0.00"   'on formate la colonne des montants (deux décimales)
      .Range("b4").Resize(n + 1, 4).AutoFilter           'on "autofiltre" le résultat
   End With
End Sub
 

Pièces jointes

Bonjour mapomme

Tu n'aimes pas les nouvelles options offertes par le Filtre automatique ?
Ou le dimanche est dans tes contrées, le jour réservé à la célébrations des Arrays ?
Une sorte de Jour de L'Array Céleste
Avec en bonus, du commentaire de bon aloi, comme disait Jacques, ce qui ne gâche rien au plaisir de se croiser sur XLD 😉

PS: Si jamais un Maciste passait par ici, puisse-t-il me dire ce qu'il en est de mon interrogation du message#9.
Merci
 
Bonjour @Staple1600 (désormais PQiste ?) 😉.

La pomme bleue ne connaissant pas Excel sur les machines de la pomme multicolore, je suis resté basique pour mon code.

Quelles sont donc les nouvelles options des filtres automatiques ?

nota : quand tu parles de la nue cosmique, tu parles de celle-ci : Array Celeste 😜 ?
 
Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Retour