Microsoft 365 faire une boucle auto pour supprimer les lignes contenant un "I" ou un "D" et copier les lignes qui contiennent un "A" dans une autre feuille excel

[Alex55]

Bonjour, je souhaite faire une boucle auto pour supprimer les lignes contenant un "I" ou un "D" et copier les lignes qui contiennent un "A" dans une autre feuille excel nommée "Incidents"

Voici le code que j'ai commencé à faire, mais je n'arrive pas à faire marcher la boucle tant que l'on a pas parcouru toutes les lignes
Dim rng As Range
Dim rng2 As Range
Dim i As Integer, Counter As Integer

'Set the range to evaluate to rng.
Set rng = Range("J2:J100")
Set rng2 = Range("B2:B100")

'initialize i to 1
i = 1

'Loop for a count of 1 to the number of rows
'in the range that you want to evaluate.
For Counter = 1 To rng.Rows.Count

'Si cellule i colonne J contient A, copier la cellule i
'dans tableau Incidents colonne A prochaine cellule vide
'Si cellule i colonne J contient D, supprimer la ligne
'Si cellule i colonne J contient I, supprimer la ligne
'Else increment i
If rng.Cells(i).Value Like "*A*" Then

ElseIf rng.Cells(i).Value Like "*D*" Then
rng.Cells(i).EntireRow.Delete
ElseIf rng.Cells(i).Value Like "*I*" Then
rng.Cells(i).EntireRow.Delete
Else
i = i + 1
End If

Next


Merci de votre aide

 

[sylvanu]

Bonjour Alex, et bienvenu sur XLD,
Essayez d'utiliser les balises </> pour le code ( à gauche de l'icone GIF ) c'est plus simple à lire, et le copier est automatique.
Un essai ci dessous :

Sub Essai()
    Dim L%
    Application.ScreenUpdating = False                                  ' Figer écran pour accélerer
    For L = 100 To 2 Step -1                                            ' Pour les lignes 2 à 100
        If Cells(L, "B") Like "*A*" Or Cells(L, "B") Like "*I*" Or _
            Cells(L, "J") Like "*A*" Or Cells(L, "J") Like "*I*" Then   ' Si contient A ou I dans colonnes B et J
                Cells(L, "A").EntireRow.Delete                          ' Supprimer ligne
        End If
    Next L
End Sub

 

[Alex55]

Bonjour sylvanu,

Merci pour votre réponse, j'ai bien réussi à supprimer la ligne selon l'argument.

Cependant je n'arrive toujours pas à copier-coller une colonne dans une autre feuille. Sauriez-vous m'éclairer sur ce point ?

 

[sylvanu]

Re,
Quelle colonne dans quelle colonne de quelle feuille ?

 

[Alex55]

la colonne B de la feuille 1 dans la colonne A de la feuille 2

 

[sylvanu]

Le principe est celui ci, mais tentez cela va prendre du temps car il va copier coller toute la colonne

Sheets("Feuille2").Range("A:A") = Sheets("Feuille1").Range("B:B").Value

Il vaut mieux limiter le copier juste pour les cellules occupées avec :

DL = Sheets("Feuille1").Range("B65000").End(xlUp).Row
Sheets("Feuille2").Range("A1:A" & DL) = Sheets("Feuille1").Range("B1:B" & DL).Value

Le copier coller se limitera juste au nécessaire.

 

[Alex55]

Merci beaucoup pour votre réponse rapide,

Pardon j'ai oublié de préciser dans ma question, mais l'idée serait de copier la colonne B et de la coller dans l'autre feuille, à la suite des cellules déjà remplies

Ex :
J'ai déjà des informations dans la colonne A Feuille 2 et je veux ajouter les infos de la colonne B Feuille 1 à la suite des informations dans la colonne A Feuille 2..

J'espère que mon explication a été claire ^^'

 

[sylvanu]

Alors tentez :

DL1 = Sheets("Feuille1").Range("B65000").End(xlUp).Row      ' Dernière ligne occupée de Feuille1
DL2 = 1 + Sheets("Feuille2").Range("A65000").End(xlUp).Row  ' Première ligne vide de Feuille2
Sheets("Feuille2").Range("A" & DL2 & ":A" & DL1 + DL2 - 1) = Sheets("Feuille1").Range("B1:B" & DL1).Value

 

[Alex55]

Merci beaucoup, je vais tester ça

 

[fanch55]

Bonsoir à tous,
une autre méthode:

Sub Test()
Dim Wsce    As Worksheet
Dim Wtgt    As Worksheet
Dim L       As Long
Dim Lmax    As Long
Dim Rng As Range
    Set Wsce = Worksheets("Feuil1")
    Set Wtgt = Worksheets("Incidents")
    Wsce.AutoFilterMode = False
    Lmax = Wsce.Cells(ActiveSheet.Rows.Count, "J").End(xlUp).Row
    With Wsce.Range("B1:J" & Lmax)
        .AutoFilter Field:=.Columns.Count, Criteria1:="=*d*", Operator:=xlOr, Criteria2:="=*i*"
        If .SpecialCells(xlCellTypeVisible).Rows.Count > 1 Then ' la ligne 1 est l'entête
            Set Rng = Wsce.Range("B2:B" & Lmax).SpecialCells(xlCellTypeVisible)
            Rng.EntireRow.Delete
        End If
        
        .AutoFilter Field:=.Columns.Count, Criteria1:="=*a*"
        If .SpecialCells(xlCellTypeVisible).Rows.Count > 1 Then ' la ligne 1 est l'entête
            Set Rng = Wsce.Range("B2:B" & Lmax).SpecialCells(xlCellTypeVisible)
            L = Wtgt.Cells(Wtgt.Rows.Count, "A").End(xlUp).Row
            If L > 1 Then L = L + 1
            Rng.Columns(1).Cells.SpecialCells(xlCellTypeVisible).Copy Wtgt.Cells(L, 1)
            Rng.EntireRow.Delete
        End If
        
    End With
    Wsce.AutoFilterMode = False

End Sub

 

[Alex55]

Bonjour,

Alors pour vous répondre à tous les deux,
Sylvanu, avec votre code j'ai un message d'erreur que je ne comprends pas sur une ligne... ça ne me propose même pas de débogage

fanch55, avec votre méthode je n'ai pas de message d'erreur mais aucune ligne ne se supprime ni ne se copie...

Sauriez-vous m'éclairer encore ?
Merci d'avance

 

[Alex55]

Pour me répondre et potentiellement simplifier le code, voici une autre solution dans la démarche :

Si on supprime les lignes avec un D ou un I, il n'y a même plus besoin de vérifier le critère A et coller directement toute la colonne B de la feuille 1 dans la colonne A (à la suite des cases déjà remplies) de la feuille "Incidents"

Peut être que ça peut simplifier le code..

 

[fanch55]

fanch55, avec votre méthode je n'ai pas de message d'erreur mais aucune ligne ne se supprime ni ne se copie...

Avez-vous renseigné la feuille en entrée ?
Set Wsce = Worksheets("Feuil1")

 

[sylvanu]

Bonjour,
Sans fichier test représentatif, il faut s' attendre à ce genre de chose.
Aucun contributeur n'a de boule de cristal, donc il imagine ce que pourrait être votre fichier...

 

[Alex55]

En effet, voici un fichier représentatif

Bonjour,
Sans fichier test représentatif, il faut s' attendre à ce genre de chose.
Aucun contributeur n'a de boule de cristal, donc il imagine ce que pourrait être votre fichier...