Discussion :

[abillon]

Bonjour,

J'ai un comportement assez bizarre de mon For Each

Je mets le morceau de code pour que ce soit plus clair :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
For Each objCell In Range(Range("col_filter_edi").Cells(2, 1), Range("col_filter_edi").End(xlDown))
        'Si il y'a la valeur "archive"
        If objCell = "archive" Then
        	'Couper coller de la ligne dans une autre feuille
        End If
 Next

Et il se passe qqch de bizarre

J'ai rajouté un MsgBox(objCell.Address) avant le If pour en etre certain mais voilà ce que se passe.

La colonne nommé est la colonne Q
Dans cette colonne il y a tjs une formule donc mon range sélectionne de Q2 à la dernière ligne remplie.

Lorsque dans Q2, Q3, Q6 et Q7 j'ai la valeur "archive", mon message box me disant à quel cellule il en est pour le For m'affiche :
Q2
Q4
Q5
Q6
Q7
Q8
Q9
Q10

Mais où est passé Q3 ??
Je me suis dit que je devais avoir un problème dans mon code quand 2 lignes à traiter se suivait mais apparemment le soucis se pose que pour Q2 et Q3. Quand je teste avec des valeurs qui se suivent pour Q3 et Q4, et Q6 et Q7 ça marche très bien ...

Si qqn veut se casser la tête avec moi, voici le fichier joint au sujet. Le code se trouve dans le module 2 et dans la fonction archiver_lignes. Cette macro est lancé quand je clique sur le bouton à côté de "Ajouter Ligne". Vous inquiétez pas je vais pas vous laisser plancher tout seul si je trouve la solution je viendrais la poster aussi !

Pour les plus impatients voilà la fonction en entier (je sens que vous êtes impatients !! ).

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
 
Sub archiver_lignes()
    'Tableau pour les lignes à supprimer
    Dim a_supprimer() As Integer
    Dim ind As Integer
 
    ind = 1
 
    Worksheets("Dde EDI - NEOPOST").Select
 
    'Pour toutes les cellules de la colonne Test archive
    'Attention le range fonctionne car dans touts les cellules de cette colonne il y a une formule
    For Each objCell In Range(Range("col_filter_edi").Cells(2, 1), Range("col_filter_edi").End(xlDown))
        MsgBox (objCell.Address)
        'Si il y'a la valeur "archive"
        If objCell = "archive" Then
            'Séléction de la ligne concerné
            Rows(objCell.Row & ":" & objCell.Row).Select
 
            'Sauvegarde des lignes à  supprimer
            ReDim Preserve a_supprimer(ind)
            a_supprimer(ind) = objCell.Row
            ind = ind + 1
 
            'Couper
            Selection.Cut
            'Sélection de la feuille d'archive
            Worksheets("Archive EDI - NEOPOST").Select
 
            'Aller à la fin
            If Range("A2") <> "" Then
                Range("A1").End(xlDown).Offset(1, 0).Select
            Else
                Range("A2").Select
            End If
 
            'Coller
            ActiveSheet.Paste
 
            'Retour à la feuille des demandes
            Worksheets("Dde EDI - NEOPOST").Select
 
 
        End If
    Next
 
    'S'il y a des lignes à supprimer
    If ind > 1 Then
        'Boucle pour supprimer les lignes
        'En partant de la fin pour pas tout décaler
        For ind = UBound(a_supprimer) To 1 Step -1
            Rows(a_supprimer(ind) & ":" & a_supprimer(ind)).Select
            Selection.Delete Shift:=xlUp
        Next
    End If
End Sub

Merci

[patbou]

bonjour

tu n as pas declaré ton objcell et pr recupérer la valeur objcell.value
en tete de module ajoute option explicit pour obligatoirement declarer les variables

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
 
Sub archiver_lignes()
    'Tableau pour les lignes à supprimer
    Dim a_supprimer() As Integer
    Dim ind As Integer
    Dim objcell As Range 'declaration de l objet range
    Dim ws  As Worksheet
    ind = 1
 
    Set ws = Worksheets("Dde EDI - NEOPOST")
 
    'Pour toutes les cellules de la colonne Test archive
    'Attention le range fonctionne car dans touts les cellules de cette colonne il y a une formule
    For Each objcell In Range(Range("col_filter_edi").Cells(2, 1), Range("col_filter_edi").End(xlDown))
             'Si il y'a la valeur "archive"
        If objcell.Value = "archive" Then   'si c la valeur de la cellule a trouver
        MsgBox objcell.adress
            'Séléction de la ligne concerné
            Rows(objcell.Row & ":" & objcell.Row).Select
 
            'Sauvegarde des lignes à  supprimer
            ReDim Preserve a_supprimer(ind)
            a_supprimer(ind) = objcell.Row
            ind = ind + 1
 
            'Couper
            Selection.Cut
            'Sélection de la feuille d'archive
            Worksheets("Archive EDI - NEOPOST").Select
 
            'Aller à la fin
            If Range("A2") <> "" Then
                Range("A1").End(xlDown).Offset(1, 0).Select
            Else
                Range("A2").Select
            End If
 
            'Coller
            ActiveSheet.Paste
 
            'Retour à la feuille des demandes
            Worksheets("Dde EDI - NEOPOST").Select
 
 
        End If
    Next
 
    'S'il y a des lignes à supprimer
    If ind > 1 Then
        'Boucle pour supprimer les lignes
        'En partant de la fin pour pas tout décaler
        For ind = UBound(a_supprimer) To 1 Step -1
            Rows(a_supprimer(ind) & ":" & a_supprimer(ind)).Select
            Selection.Delete Shift:=xlUp
        Next
    End If
End Sub

[alsimbad]

il se passe qqch de bizarre

J'ai un comportement assez bizarre

Je me suis dit que je devais avoir un problème

Vous inquiétez pas

dans ton code
bon, , je t'ai retrouvé ton q3, j'ai rien demandé, j'ai tapé F8 dans ton code. a preuve :

[alsimbad]

hé ben , je te demande pardon. j'ai réussi en modifaint ta formule pour que la valeur soit ("archive, puis en l'incrémentant a faire en sorte que dans le fichier joint l'erreur soit plus flagrant. pour le moment, j'ai pas la solution, mais je cherche, ne serais que pour m'etre moqué

[abillon]

ok ,

Du coup après avoir vu ton message j'ai repassé en boucle le truc en me disant mais comment ça se fait que lui le voit et pas moi

Merci de s'intéresser à mon petit problème !! Je planche toujours dessus . Dès que j'ai des nouvelles ou que j'ai trouvé la solution je posterai !

[Edit]
Bon dans mon For Each au lieu de commencer à Q2, je commence à Q1 du coup ça marche. Mais bon ça me dit tjs pas pourquoi en commençant à Q2 ça fonctionne pas, surtout que je voudrais éviter de tester ma colonne de titre ...

[alsimbad]

je n'ai pas exactement réussi à determiner pourquoi la ligne 3, mais je suis presque sur que l'erreur vient de tes select. il faut vraiment l'éviter. ça fatigue les yeux et ça ralenti le code. du coup pour me faire pardonner de m'etre moqué de toi, je t'ai refait ton code, je pense que l'exemple pourras te servir pour modifier et améliorer un peu les autres patie de ta macro

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
 
Sub archiver_lignes()
    'Tableau pour les lignes à supprimer
    Dim a_supprimer() As Integer
    Dim ind As Integer
    ind = 1
    Set source = Worksheets("Dde EDI - NEOPOST")
    Set cible = Worksheets("Archive EDI - NEOPOST")
    derligne = source.Range("q65536").End(xlUp).Row
    Set zonesource = Range("q2:q" & derligne)
    'Pour toutes les cellules de la colonne Test archive
      For Each objCell In zonesource
        'Si il y'a la valeur "archive"
        lignecible = cible.Range("A65536").End(xlUp).Row + 1
        If objCell.Value = "archive" Then
           objCell.EntireRow.Copy (cible.Rows(lignecible))
            'Sauvegarde des lignes à  supprimer
            ReDim Preserve a_supprimer(ind)
            a_supprimer(ind) = objCell.Row
            ind = ind + 1
        End If
    Next objCell
    'S'il y a des lignes à supprimer
    If ind > 1 Then
        'Boucle pour supprimer les lignes
        'En partant de la fin pour pas tout décaler
        For ind = UBound(a_supprimer) To 1 Step -1
            source.Rows(a_supprimer(ind)).Delete
        Next
    End If
End Sub

petits conseil
n'oublie pas de déclarer tes variables, ne serais que pour y voir clair
n'utilise pas les select. il n'y a que les tris, je crois qui obligent a l'utiliser)
ps : je l'ai testé un peu, mais bon, il reste surement des erreurs

[abillon]

ok merci je vais tester ça !!

J'ai commencé le VBA Excel il y a 2 semaines, donc je tatonne . C'est vrai que les Select font mal aux yeux mais si y'a d'autres solutions je suis preneur .

EDIT :
Merci pour ta solution !! ça évite des clignotements de partout !
J'ai modifié pour un peu le code pour intégrer les noms de colonnes !