VBA - Archiver lignes selon un critère "Non" dans TB feuille "ARCHIVES"

Bonjour

Je n'arrive pas adapter ce code qui fonctionnait très bien sur un autre fichier.

Est-ce que quelqu'un peut m'aider à trouver ce que je dois corriger svp. Voilà où plante la macro. Fichier test en PJ.

22pour-xlp.xlsm (31.67 Ko)

Elle doit archiver les lignes du TB de l'onglet BDD vers le TB de l'onglet ARCHIVES dès lors qu'elle verra la valeur "Non" dans la colonne TOTO (AB)

image

Par avance, merci de votre aide.

Bonsoir,

Teste en mettant dans la ligne With Range("Tableau111") à la place d' ("ARCHIVES")

Sub ARCHIVER()
Dim rDelete As Range
With Range("Tableau1")
    t = .Value
    For I = 1 To .Rows.Count
        If .ListObject.ListColumns("TOTO").DataBodyRange(I, 1) = "Non" Then
            n = n + 1
            For AB = 1 To .Columns.Count
                t(n, AB) = t(I, AB)
            Next AB
            If rDelete Is Nothing Then Set rDelete = .Rows(I) Else Set rDelete = Union(rDelete, .Rows(I))
        End If
    Next I
End With
If n > 0 Then
    With Range("Tableau111")
        If Not .ListObject.DataBodyRange Is Nothing And .Cells(1, 1) = "" Then
            .Rows(1).Resize(n, UBound(t, 2)).Value = t
        Else
            .ListObject.ListRows.Add.Range.Resize(n, UBound(t, 2)).Value = t
        End If
    End With
    rDelete.Delete xlUp
    sPluriel = IIf(n = 1, "", "s")
    MsgBox "Il y a " & n & " ligne" & sPluriel & " archivée" & sPluriel & "."
Else
    MsgBox "Aucune donnée n'a été archivée !", vbExclamation, "Défaut de correspondance"
End If
End Sub

Slts

Bonjour,

Un peu compliqué le code.

Par contre à partir du moment ou je vois des "Delete x1up" je peux déjà dire que l'utilisation de For i = 1 to ... çà va pas le faire.

- Premièrement les données de votre tableaux sont à la ligne 7 donc i devrait être = à 7 pour le test.

- Deuxièmement lors de l'utilisation de For i en cas de suppression de ligne on ne commence jamais par le début mais par la fin.

- Troisièmement votre tableau ne commence pas colonne A pourquoi une colonne vide ?

Votre boucle pour les test devrait être dans cet exemple : de la ligne 10 à la ligne 7 en remontant. ( aprés avoir supprimé cet colonne a vide)

derligne = Cells(Rows.Count, 1).End(xlUp).Row
For i = derligne To 7 Step -1

Boss_68 Merci beaucoup !

Xmenpl

Je prends note de vos conseils. Toutefois, je commence en colonne B (parce que j'ai envie, est-ce problématique dans le cas présent ?)

Cordialement.

Non mais dans ce cas le test sera sur la colonne B ( 2)

derligne = Cells(Rows.Count, 2).End(xlUp).Row
Rechercher des sujets similaires à "vba archiver lignes critere feuille archives"