Transfert de ligne sur une autre feuille suivant des critères

Bonjour à tous, de nouveau j'ai besoin de vous ; -)

J'aimerais que dans la feuille Trié ,je n'ai que les lignes où il n'y à pas de x sur la colonne b (de la feuille trié),

Je peux mettre ce qu'il y a en dessous mais ça me demande beaucoup de ligne à rajouter.

Fichier joint

For I = Range("h65536").End(xlUp).Row To 1 Step -1

If Range("h" & I) = "En Automatique" Then Range("B" & I).EntireRow.Delete

If Range("h" & I) = "En Manuel" Then Range("B" & I).EntireRow.Delete

If Range("h" & I) = "En Défaut" Then Range("B" & I).EntireRow.Delete

If Range("h" & I) = "En Arrêt" Then Range("B" & I).EntireRow.Delete

If Range("h" & I) = "F019 : Arret d'urgence déclenché" Then Range("B" & I).EntireRow.Delete

If Range("h" & I) = "Système arrêté" Then Range("B" & I).EntireRow.Delete

If Range("h" & I) = "Alarme de capteur : Barrière multifaisceaux activée." Then Range("B" & I).EntireRow.Delete

If Range("h" & I) = "Arret du mouvement de la balancelle" Then Range("B" & I).EntireRow.Delete

If Range("h" & I) = "Arrêt d'urgence activé depuis un système externe" Then Range("B" & I).EntireRow.Delete

If Range("h" & I) = "Avertissement: Demande d'accès pour le robot est demandé ou accepté." Then Range("B" & I).EntireRow.Delete

Next I

merci d'avance

Bonjour,

ta feuille "trié" est vide ...

mais voici une proposition

Sub aargh()
    With Sheets("trié")
        dl = .Cells(Rows.Count, 2).End(xlUp).Row
        If dl > 1 Then
            For i = dl To 1 Step -1
                If UCase(.Cells(i, 2)) = "X" Then .Rows(i).Delete shift:=xlUp
            Next i
        End If
    End With
End Sub

Salut h2so4

Désolé, je me suis mal expliqué, j'aimerais que dans la feuille Trié soit copié toutes les lignes de la feuille données dont ,dans la colonne "texte du message" n'ont pas de x dans la colonne b(de la feuille Liste des défauts).

la feuille liste des défauts est pour moi un critère

Je sais que c'est un peu embrouillé, désolé.

Bonjour,

une proposition

Sub aargh()
    Set wsd = Sheets("liste des défauts")
    With wsd
        dl = .Cells(Rows.Count, 1).End(xlUp).Row
        .Range("A1:B" & dl).Sort key1:=.Range("B1"), order1:=xlDescending, Header:=xlYes
        dl = .Cells(Rows.Count, 2).End(xlUp).Row
        Set pld = .Range("A2:A" & dl)
    End With
    Set ws = Sheets("trié")
    k = 1
    With Sheets("données")
        dl = .Cells(Rows.Count, 1).End(xlUp).Row
        .Cells(1, 1).Resize(dl, 3).Copy ws.Cells(1, 1)
    End With
    With ws
        For i = dl To 2 Step -1
            For Each m In pld
                m.Replace "[Convoyeur]", "", lookat:=xlPart
                m.Replace "[Balancelle]", "", lookat:=xlPart
                If Left(.Cells(i, 3), Len(m)) = m Then .Rows(i).Delete Shift:=xlUp: Exit For
            Next m
        Next i
    End With
End Sub

Rebonjour h2so4

Merci, cela fonctionne bien, peux tu m'explique ton code car je suis un débutant en vba.

Surtout ce code,

With ws

For i = dl To 2 Step -1

For Each m In pld

m.Replace "[Convoyeur]", "", lookat:=xlPart

m.Replace "[Balancelle]", "", lookat:=xlPart

If Left(.Cells(i, 3), Len(m)) = m Then .Rows(i).Delete Shift:=xlUp: Exit For

Next m

Next i

End With

En te remerciant

re-bonjour,

voici quelques commentaires

Sub aargh()
    Set wsd = Sheets("liste des défauts") ' on prend la feuille liste des défauts
    With wsd
        dl = .Cells(Rows.Count, 1).End(xlUp).Row 'nombre de lignes sur wsd
        ' on trie la liste en mettant les lignes avec un X en haut de la liste
        .Range("A1:B" & dl).Sort key1:=.Range("B1"), order1:=xlDescending, Header:=xlYes
        dl = .Cells(Rows.Count, 2).End(xlUp).Row 'dl n° de  la dernière ligne avec un X
        Set pld = .Range("A2:A" & dl) ' pld plage des messages à éliminer
    End With
    Set ws = Sheets("trié") 'ws = feuille trié
    With Sheets("données") 'on copie données sur trié
        dl = .Cells(Rows.Count, 1).End(xlUp).Row 'dl n° de la dernière ligne de ws ou données
        .Cells(1, 1).Resize(dl, 3).Copy ws.Cells(1, 1)
    End With
    With ws 'on prend la feuille ws
        For i = dl To 2 Step -1 ' pour chaque ligne à partir de la dernière
            For Each m In pld ' on prend chaque message defaut à éliminer
                m.Replace "[Convoyeur]", "", lookat:=xlPart ' on enlève le texte [Convoyeur]
                m.Replace "[Balancelle]", "", lookat:=xlPart 'on enlève le texte [Balancelle]
                ' si la partie droite du message de la ligne de ws correspond au message à éliminer, on supprime la ligne et on passe à la ligne suivante
                If Left(.Cells(i, 3), Len(m)) = m Then .Rows(i).Delete Shift:=xlUp: Exit For
            Next m 'on n'a pas trouvé le message m dans la ligne on prend le message m suivant
        Next i 'on passe à la ligne suivante
    End With
End Sub

Dernière question, par curiosité pourquoi supprimer ces items ?

m.Replace "[Convoyeur]", "", lookat:=xlPart

m.Replace "[Balancelle]", "", lookat:=xlPart

merci

bonsoir,

[convoyeur] et [balancelle] ne se retrouveront jamais tels quels dans tes messages, ils seront remplacés par un id de convoyeur et un id de balancelle.

donc si je cherche à éliminer les messages "F031 : Réserve [Convoyeur]", je n'en trouverai aucun, même si j'ai des messages "F031 : Réserve A01CB". la macro fait donc une recherche sur "F031 : Réserve " pour éliminer ces messages.

Merci pour ta patience ainsi que ppour toutes les explications fournies.

Bonne fête de fin d'année