Discussion :

[fcjunic]

Bonjour,

J'ai un tableau excel avec plusieurs lignes.
J'aimerais simplement déplacer certaines lignes de ce tableau vers une autre feuille à condition que la valeur d'une colonne soit égale à une certaine valeur.

Voici le code que j'ai fait mais j'ai une erreur à l'exécution

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
Sub CopyToFeuille2()
    Dim wsSource As Worksheet
    Dim wsCible As Worksheet
    Dim derniereLigne As Long
    Dim tmpLigne As Long
    Dim i As Long
 
    Set wsSource = Worksheets("Feuil1")
    Set wsCible = Worksheets("Feuil2")
 
    tmpLigne = Sheets("Feuil2").Range("A65536").End(xlUp).Row + 1
 
    'On récupère la dernière ligne remplie
    derniereLigne = Range("A" & Rows.Count).End(xlUp).Row
 
    'Pour chaque ligne du fichier source
    For i = 1 To derniereLigne
        'Si la colonne H contient "signé" --> deplacer vers Feuil2
        If wsSource.Cells(i, "H").Value = "signé" Then
            wsSource.Range("A:H" & i).Copy wsCible.Range("A:H" & tmpLigne)
            wsSource.Range("A:H" & i).ClearContents
 
            tmpLigne = tmpLigne + 1
        End If
    Next i
End Sub

Merci pour votre aide

[Philippe Tulliez]

Bonsoir,
D'après tes explications, je pense que les filtres avancés d'excel devraient t'apporter la solution.
Voir ici Les filtres avancés ou élaborés dans Excel

[fcjunic]

Merci mais concernant le code que j'ai posté, que faut-il changer pour que cela fonctionne ? Merci

[Philippe Tulliez]

Bonjour,
Connais-tu les filtres avancés d'excel ?
As-tu jeté un coup d'oeil sur le tuto qui lui même est accompagné d'un fichier à télécharger qui lui même contient un code VBA qui devrait répondre à ta question.
Tu peux aussi regarder ce fil qui contient une explication et une petite procédure qui devrait te faire avancer dans ton questionnement.

[fcjunic]

Merci pour votre réponse, mais, pour ma part, j'aimerais que le filtre soit automatique et qu'il fasse un couper/coller et non un copier/coller.

Imaginons que j'ai 100 lignes remplies pour les colonnes A et B.
J'aimerais que toutes les lignes qui ont comme valeur 'X' dans la colonne B soient déplacées (couper/coller) dans la Feuil2 du classeur, et ce automatiquement.

La cerise sur le gateau serait qu'une fois dans la Feuil2, si je remets dans la colonne B une autre valeur que X, alors la ligne en question "retourne" dans la Feuil1.

J'ai l'impression que ce n'est pas si simple à faire sans rien coder du tout...

[NVCfrm]

Bonsoir...,

je te proposes une petite modification de ton code

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
Sub CopyToFeuille2()
    Dim wsSource As range
    Dim wsCible As Range
    Dim derniereLigne As Long
    Dim tmpLigne As Long
    Dim i As Long
 
    Set wsSource = Worksheets("Feuil1").Range("a1:h1")
    tmpLigne = Sheets("Feuil2").Range("A65536").End(xlUp).Row + 1
 
    'On récupère la dernière ligne remplie dans un objet range
    derniereLigne = Range("A" & Rows.Count).End(xlUp).Row
    set wsCible = Worksheets("Feuil2").Range("a" & derniereLigne &":h" & derniereLigne")
 
    i = 1 
    'Pour chaque ligne du fichier source
    do 'i = 1 To derniereLigne
        'Si la colonne H contient "signé" --> deplacer vers Feuil2
        If wsSource.Cells(i, "H").Value = "signé" Then
            wsCible.Rows(derniereLigne).Value = wsSource.Rows(i).Value
            wsSourceRows(i).Delete
            derniereLigne = derniereLigne + 1
            tmpLigne  = tmpLigne - 1 ' ajuster le nombre de lignes restant
            i = i -1 'Redressement
        End If
        i = i + 1
    Loop Until i <= tmpLigne 
End Sub

à mon avis c'est ce que tu souhaites faire?