Macro pour ne faire ressortir que certains élèments

Question

Etant nouvelle et ne sachant pas si ce sujet à déjà été abordé, je m'excuses d'avance. Alors voilà mon problème. J'ai un tableau avec MFC et je souhaiterais grâce à cette MFC et à une Macro, faire ressortir dans un second tableau les lignes en rouges. Quelqu'un pour m'aider à résoudre ce soucis ? Je vous remercie pour le temps que vous prendrez pour me répondre...

ThauThème · Accepted Answer

Re, Il y avait une erreur dans mon code du fait que ton tableau commence à la ligne 2. En pièce jointe la version 02 corrigée ...

gmb · Answer

Un essai à tester. Te convient-il ? Bye ...

ThauThème · Answer

Bonjour Lyssandra, Gmb, bonjour le forum,

Un autre proposition avec le code ci-dessous :

Sub Macro1()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim PL As Range 'déclare la variable PL (PLage)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)

Set OS = Worksheets("Feuil1") 'définit l'onglet OS
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
Set OD = Worksheets("Feuil2") 'définit l'onglet OD (génère une erreur si cet onglet n'existe pas)
If Err <> 0 Then 'condition : si une erreur a été générée
    Err.Clear 'supprime l'erreur
    Worksheets.Add After:=OS 'ajoute un onglet vierge après l'onglet OS
    Set OD = ActiveSheet 'définit l'onglet OD
    OD.Name = "Feuil2" '' renomme l'onglet OD
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
OD.Cells.ClearContents 'efface le contenu des  cellules de l'onglet OD
DL = OS.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne A de l'onglet OS
Set PL = OS.Range("A2:G" & DL) 'définit la plage PL
For I = 3 To DL 'boucle 1 : sur toutes les lignes I de 3 à DL
    If OS.Cells(I, "G") < OS.Cells(I, "C") Then 'condition : si la valeur en colonne G est inférieure à la valeur en colonne C
        K = K + 1 'incrémente K
        ReDim Preserve TL(1 To 7, 1 To K) 'redimensionne le tableau des lignes TL (7lignes, K colonnes)
        For J = 1 To PL.Columns.Count 'boucle 2 : sur toutes les colonnes de la plage PL
            TL(J, K) = PL(I, J) 'récupère dans la colonne J de TL la valeur de la cellule ligne I colonne J de la plage PL
        Next J 'prochaine colonne de la boucle 2
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle 1
PL.Rows(1).Copy OD.Range("A1") 'copie la première ligne de la plage PL dans la cellule A1 de l'onglet OD
'si K est supérieure à 0 renvoie le tableau TL transposé dans la cellule A2 redimensionnée
If K > 0 Then OD.Range("A2").Resize(K, PL.Columns.Count).Value = Application.Transpose(TL)
OD.Columns("A:G").AutoFit 'ajustement des colonnes A à G
End Sub

Le code fonctionnera jusqu'à plus de 32 000 lignes mais le tableau doit toujours commencer en A2. Le résultat se trouve dans l'onglet Feuil2 qui est créé s'il n'existe pas. Tu peux y rajouter une MFC sans problème (idem pour le code de Gmb).

Ton fichier modifié :

1lyssandra-ep-v01.xlsm (25.40 Ko)