Macro pour filtrer une certaine couleur de cellule

Question

Je sollicite votre aide car je galère un peu (beaucoup) sur ma macro. Celle-ci doit: - copier trois plages de données de la feuille "Import" (1) vers les feuilles 2 à 9 (les plages sont différentes pour chacune) - une fois ceci fait, il faut que (dans chacune des feuilles de 2 à 9 inclus) si la cellule de la colonne G est vide OU (non exclusif) si la cellule de la colonne F n'est pas colorée en blanc (si elle est en vert, mais ce n'est pas une couleur de base excel, donc cela équivaut à dire qu'elle n'est pas en blanc), il faut supprimer la ligne entière - enfin, il faut faire un copier-coller spécial "valeurs" des cellules des colonnes H et I: celles-ci contiennent la formule suivante: =SI(C4&lt;&gt;"";CONCATENER(C4;"M");"") 'colonne H =SI(C4&lt;&gt;"";CONCATENER(C4;"N");"") 'colonne I La structure du fichier est la suivante: Feuille 1: Des données "brutes" organisées par colonne, de A à BI Feuilles 2 à 9: Des colonnes avec en-têtes de A à I Feuille 10: Une cellule fusionnée, qui sort du cadre de ma demande. Rien à toucher dans cette feuille. Pour cela, j'ai bricolé quelque chose à l'aide d'internet et de mes maigres compétences en VBA, mais ça ne produit pas le résultat escompté, surtout au niveau de la partie qui supprime les cellules si elles sont vertes: Merci d'avance Sub MaMacro() Dim J As Integer Sheets("Import").Range("B:C").Copy Sheets(2).Range("A:B") Sheets("Import").Range("G:G").Copy Sheets(2).Range("C:C") Sheets("Import").Range("J:M").Copy Sheets(2).Range("D:G") Sheets("Import").Range("B:C").Copy Sheets(3).Range("A:B") Sheets("Import").Range("G:G").Copy Sheets(3).Range("C:C") Sheets("Import").Range("R:U").Copy Sheets(3).Range("D:G") Sheets("Import").Range("B:C").Copy Sheets(4).Range("A:B") Sheets("Import").Range("G:G").Copy Sheets(4).Range("C:C") Sheets("Import").Range("V:Y").Copy Sheets(4).Range("D:G") Sheets("Import").Range("B:C").Copy Sheets(5).Range("A:B") Sheets("Import").Range("G:G").Copy Sheets(5).Range("C:C") Sheets("Import").Range("Z:AC").Copy Sheets(5).Range("D:G") Sheets("Import").Range("B:C").Copy Sheets(6).Range("A:B") Sheets("Import").Range("G:G").Copy Sheets(6).Range("C:C") Sheets("Import").Range("AL:AO").Copy Sheets(6).Range("D:G") Sheets("Import").Range("B:C").Copy Sheets(7).Range("A:B") Sheets("Import").Range("G:G").Copy Sheets(7).Range("C:C") Sheets("Import").Range("AT:AW").Copy Sheets(7).Range("D:G") Sheets("Import").Range("B:C").Copy Sheets(8).Range("A:B") Sheets("Import").Range("G:G").Copy Sheets(8).Range("C:C") Sheets("Import").Range("AX:BA").Copy Sheets(8).Range("D:G") Sheets("Import").Range("B:C").Copy Sheets(9).Range("A:B") Sheets("Import").Range("G:G").Copy Sheets(9).Range("C:C") Sheets("Import").Range("BF:BI").Copy Sheets(9).Range("D:G") For J = 2 To 9 Application.ScreenUpdating = True 'Sheets(J).Select Dim I As Long Dim redRng As Range Set redRng = Range("F2", Range("F600").End(xlUp)) Set ws = Sheets(J) With Sheets(J) lRow = .Range("G" & Rows.Count).End(xlUp).Row 'Colonne G = delta For I = lRow To 2 Step -1 If InStr(Sheets(J).Range("G" & I), "") = 0 Or Sheets(J).Cells(I, "F").Interior.ColorIndex &lt;&gt; 2 Then .Range("G" & I).EntireRow.Delete End If Next I Exit For 'Dim Nodel As Boolean 'lastrow2 = Sheets(J).Range("F" & Rows.Count).End(xlUp).Row 'For H = lastrow2 To 2 Step -1 'Nodel = False 'If .Cells(H, "F").Interior.ColorIndex = 2 Then Nodel = True 'If Not Nodel Then .Rows(H).EntireRow.Delete 'Next H End With Next J End Sub...

Invité · Answer

Tu peux déjà commencer par remplacer tes 3*9 lignes par ceci Dim NbF As Integer, TabPlge() As String Application.ScreenUpdating = True ' Définir le tableau des plages TabPlge = Split("J:M,R:U,V:Y,Z:AC,AL:AO,AT:AW,Ax:BA,BF:BI", ",") ' Pour chaque feuille à traiter For NbF = 2 To 9 Sheets("Import").Range("B:C").Copy Sheets(NbF).Range("A:B") Sheets("Import").Range("G:G").Copy Sheets(NbF).Range("C:C") Sheets("Import").Range(TabPlge(NbF - 2)).Copy Sheets(2).Range("D:G") Next NbF A+...