Recherche de lignes oranges...

[DisMoiOui]

Bonjour à tous!

Je cherche à éditer une fonction me permettant de copier toutes les lignes comportant des cases de couleur orange (ColorIndex = 40) de tous les onglets d'un classeur et de les coller dans un dernier onglet de synthèse. Je précise que ces lignes sont toutes comprises dans des plages nommées au préalable.

Merci de votre aide!!

 

[BOISGONTIER]

Re : Recherche de lignes oranges...

Bonjour,

Sub Archives2()
  Sheets("Archives").Range("A2:F65000").ClearContents
  ligneRecap = 1
  For Each s In Array("feuil1", "feuil2")
    For i = 2 To Sheets(s).[a65000].End(xlUp).Row
      If Sheets(s).Cells(i, 1).Interior.ColorIndex = 44 Then
        ligneRecap = ligneRecap + 1
        Sheets(s).Cells(i, 1).Resize(1, 3).Copy Sheets("Archives").Cells(ligneRecap, 1)
      End If
    Next i
  Next s
End Sub

JB
Formation Excel VBA JB

 

[Staple1600]

Re : Recherche de lignes oranges...

Bonjour à tous



Une autre proposition

Sub orange()
Dim i As Long
Dim Cell As Range
Dim S_Wkb As Worksheet
Set S_Wkb = Sheets.Add
S_Wkb.Name = "Synthèse"
For i = 1 To ThisWorkbook.Sheets.Count
If Sheets(i).Name <> "Synthèse" Then
For Each Cell In Sheets(i).UsedRange
If Cell.Interior.ColorIndex = 40 Then
With Cell
.Copy
S_Wkb.Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
End With
End If
Next Cell
End If
Next i
End Sub

Reste à gérer le test d'existente de la feuille Synthèse (sinon bug à la deuxilème éxécution de la macro.)

Le temps de boire mon café et je m'y colle.

 

[Staple1600]

Re : Recherche de lignes oranges...

Re



Café bu , macro pondue

Sub orange_II()
Dim i As Long
Dim Cell As Range
Dim S_Wkb As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
If Not ThisWorkbook.Sheets("Synthèse") Is Nothing Then
ThisWorkbook.Sheets("Synthèse").Delete
End If

Set S_Wkb = Sheets.Add
S_Wkb.Name = "Synthèse"

For i = 1 To ThisWorkbook.Sheets.Count
If Sheets(i).Name <> "Synthèse" Then
For Each Cell In Sheets(i).UsedRange
If Cell.Interior.ColorIndex = 40 Then
With Cell
.Copy
S_Wkb.Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
End With
End If
Next Cell
End If
Next i
Application.ScreenUpdating = True
End Sub

 

[DisMoiOui]

Re : Recherche de lignes oranges...

Merci beaucoup pour votre aide super rapide!!! Mais j'aimerai savoir si c'était possible de copier les lignes complètes comprenant certaines cellules oranges, sachant que parmi ces cellules, certaines ne comprènent pas de texte...

Merci encore!

 

[DisMoiOui]

Re : Recherche de lignes oranges...

Du coup j'essaye de faire un mix entre vos deux codes, ça donne ça , mais ca ne marche pas...🙁

    Dim i As Long
    Dim Cell As Range
    Dim S_Wkb As Worksheet
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
      

    If Not ThisWorkbook.Sheets("Synthèse") Is Nothing Then
        ThisWorkbook.Sheets("Synthèse").Delete
    End If
    
    Set S_Wkb = Sheets.Add
    S_Wkb.Name = "Synthèse"
    ligneRecap = 1
    
    For i = 1 To ThisWorkbook.Sheets.Count
    If Sheets(i).Name <> "Synthèse" Then
        For Each s In Sheets(i).UsedRange
          For t = 2 To Sheets(s).[a65000].End(xlUp).Row
            If Sheets(s).Cells(t, 1).Interior.ColorIndex = 40 Then
              ligneRecap = ligneRecap + 1
              Sheets(s).Cells(t, 1).Resize(1, 3).Copy Sheets("Synthèse").Cells(ligneRecap, 1)
            End If
          Next t
        Next s
    End If
    Next i
    Application.ScreenUpdating = True

 

[Staple1600]

Re : Recherche de lignes oranges...

Re



Aurais-tu un fichier exemple à poster ici (sans données confidentielles et zippé, stp) ?

 

[DisMoiOui]

Re : Recherche de lignes oranges...

Voila le fichier allégé. Je crée des onglets projet, par exemple l'onglet A23 à partir de la page d'accueil, et dans ces projets, j'ai des TA (tracteurs...) qui peuvent avoir des incidents, auquel cas la ligne créée apparait en orange.
L'idée, c que lorsque tout les projets sont remplis, je click sur le bouton Synthèse de mon onglet accueil pour avoir toutes mes lignes oranges d'incidents dans un onglet Synthèse.

En tout cas merci encore pour ton aide!

 

[DisMoiOui]

Re : Recherche de lignes oranges...

Juste pour dire que je me suis finalement débrouillé avec vos codes, en bricolant un peu ça marche très bien!

Merci à vous deux