Suppression de ligne en fonction de cellules de couleur dans une colonne

Bonjour,

Tout d'abord j'espère que vous allez bien et je vous remercie de m'accorder du temps et votre potentielle aide

Alors voila j'aurai besoin d'un code VBA me permettant de supprimer les cases blanches et orange de la colonne AA. Il est donc sensé me rester que les cases rouges.

Sachant que l'attribution de ces couleurs (sauf pour le blanc) se fait par des règles de comparaison entre les colonnes E et AB.

Par avance merci beaucoup de votre aide ;

Cordialement.

Bonjour,

Pour utiliser les couleurs créées par MFC, on utilise .displayFormat

Vu qu'on supprime les lignes, j'ai du modifier les consignes de MFC.

Le code reste lent vu qu'il y a bcp de donnés.

Sub test21()
Dim i As Long
For i = 2 To Cells(Rows.Count, 27).End(xlUp).Row
Calculation = xlCalculationManual
If Cells(i, 27).DisplayFormat.Interior.Color = 49407 Or Cells(i, 27).DisplayFormat.Interior.Color = 16777215 Then
Rows(i).Delete
i = i - 1
End If
Next i
Calculation = xlCalculationAutomatic
End Sub

Bonjour Roijio, Numéro 2, le forum,

Un autre essai....(Attention au format de la colonne E, j'ai remplacé les . par des , ).

(Si AA <> "" et E > AB)

Sub Macro1()
 Dim dl As Long, tablo, tabloR(), k As Long, i As Long

  With Sheets("Feuil2")
   dl = .Range("E" & Rows.Count).End(xlUp).Row
   tablo = .Range("E3:AB" & dl)

    k = 0
    For i = 1 To UBound(tablo, 1)
     If tablo(i, 23) <> "" And tablo(i, 1) > tablo(i, 24) Then
      ReDim Preserve tabloR(1 To 24, 1 To k + 1)
       For j = 1 To 24
        tabloR(j, 1 + k) = tablo(i, j)
       Next j
    k = 1 + k
     End If
    Next i
     .Range("E3:AB" & dl).ClearContents
      On Error Resume Next
     .Range("E3").Resize(UBound(tabloR, 2), 24) = Application.Transpose(tabloR)
   End With
End Sub

CTRL + e pour lancer la macro.

Cordialement,

Bonjour,

Merci beaucoup vous m'avez sauvé la vie !!

Ca marche au poil !!

Bonne journée à vous,

Roijio.