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

XLDnaute Nouveau
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
 
Solution
Salut,
en fait, c'est un #N/A qui provoque la copie.
avec le classeur joint, c'est nettement mieux ..
VB:
Sub TestF55()
Dim Wsce    As Worksheet
Dim Wtgt    As Worksheet
Dim L       As Long
Dim Lmax    As Long
Dim Rng     As Range
    Set Wsce = Worksheets("Mes actions")
    Set Wtgt = Worksheets("Incidents")
    Wsce.AutoFilterMode = False
    Lmax = Wsce.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
    On Error Resume Next
    With Wsce.Range("A1:K" & Lmax)
        
        .AutoFilter Field:=.Columns.Count, Criteria1:="=*d*", Operator:=xlOr, Criteria2:="=*i*"
        Set Rng = Wsce.Range("A2:K" & Lmax).SpecialCells(xlCellTypeVisible) ' la ligne 1 est l'entête
        If Not Rng Is Nothing Then Rng.EntireRow.Delete...

sylvanu

XLDnaute Barbatruc
Supporter XLD
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 :
VB:
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

XLDnaute Nouveau
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

XLDnaute Barbatruc
Supporter XLD
Le principe est celui ci, mais tentez cela va prendre du temps car il va copier coller toute la colonne
VB:
Sheets("Feuille2").Range("A:A") = Sheets("Feuille1").Range("B:B").Value
Il vaut mieux limiter le copier juste pour les cellules occupées avec :
Code:
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

XLDnaute Nouveau
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

XLDnaute Barbatruc
Supporter XLD
Alors tentez :
VB:
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
 

fanch55

XLDnaute Barbatruc
Bonsoir à tous,
une autre méthode:
VB:
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

XLDnaute Nouveau
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

XLDnaute Nouveau
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..
 

Discussions similaires

Statistiques des forums

Discussions
299 841
Messages
1 979 475
Membres
206 744
dernier inscrit
Nicolas258