Copier/coller plusieurs lignes selon couleur de fond

Bonjour!

Nouvelle venue sur le site que j'apprécie! Mais j'ai du mal, surement un peu blonde!!

Mon problème : sur un fichier excel comportant plusieurs feuilles (un peu normal.... ), je cherche à importer les lignes colorées (et leur contenu) de toutes les feuilles vers la première feuille (feuille de synthèse des actions urgentes à mener). J'ai essayé sur un fichier test et j'ai trouvé un code qui me copie l'intégralité des feuilles (sur la feuille 3 de mon document). Je n'arrive pas à insérer la condition sur la couleur de fond. Certes cela ne fait que deux jours que je me suis plongée dans VBA mais bon......

Un grand merci pour votre attention!!

Timtam

Bonjour, sur le vrai fichier les informations sont aussi de la colonne A a K ?

Essayez de comparer la couleur de la cellule/plage que vous lisez par la couleur par défaut d'excel qui est 0

Ex :

if cells(ligne,colonne).Interior.ColorIndex <> 0 then

Bonjour Force Rouge et merci pour la réponse!

Voici le code que j'ai :

Option Explicit

Dim f, n, lgn

Sub Importer1()

Application.ScreenUpdating = False

Cells.ClearContents

n = 0

For Each f In Worksheets

If f.Name <> ActiveSheet.Name Then

n = n + 1

If n = 1 Then

f.Range("A1:K" & f.Range("A" & Rows.Count).End(xlUp).Row).Copy

lgn = 1

Else

f.Range("A1:K" & f.Range("A" & Rows.Count).End(xlUp).Row).Copy

lgn = Range("A" & Rows.Count).End(xlUp).Row + 1

End If

Cells(lgn, 1).PasteSpecial xlPasteAll

End If

Next f

Range("A1").Select

End Sub

Et je n'arrive pas à insérer la ligne que vous avez suggérer.....

Dans le vrai fichier, je vais vous dire que je ne sais pas combien de lignes et colonnes sur chaque page, c'est le fichier de mon chef!!

mais j'espère que j'arriverai à adapter par la suite!!! Il me reste le tri par la couleur.....

Merci beaucoup!

Timtam

Bonjour, pour ma part je ne comprends pas trop votre code mais ce que je vous ai dit précédemment permet de tester si une cellule à un fond en couleur.

 if cells(1,1).Interior.ColorIndex <> 0 then

Ca veut dire si la cellule A1 à une couleur de fond alors..

Rebonjour Force Rouge,

Après avoir galéré toute la journée, j'ai enfin trouvé une solution et j'applique le code sur chacune des feuilles de mon fichier. En espérant que cela puisse fonctionner avec le fichier définitif.

Voici le code que j'ai fait, avec votre aide et en continuant à chercher :

Sub contrôle()

Dim i As Integer

Dim j As Integer

Dim ln As Integer

For i = 1 To 50

ln = Sheets("feuil3").Range("A" & Rows.Count).End(xlUp).Row + 1

For j = 1 To 50

If Cells(i, j).Interior.Color = RGB(255, 0, 0) Then

Cells(i, j).Copy

Sheets("feuil3").Cells(ln, j).PasteSpecial xlPasteAll

End If

Next j

Next i

End Sub

La feuille 3 est ma feuille de synthèse....

Encore merci pour votre aide et bonne fin de journée!!

Timtam