Déplacer une ligne dans une autre feuille en fonction d'un critère [Résolu]

[moi244]

* Bonjour *

Comment je peux coder ceci? Si une cellule de la colonne A dans la feuil1 contient le caractère "x", alors coupe toute la ligne (qui contient le "x") dans la prochaine ligne non vide de la feuil2, et supprime l’ancienne ligne.
je sais que ce que je veux ressemble à ce code, mais j'ai un peu de difficulté.
Merci

Envoyé par SilkyRoad

bonsoir


Tu peux essayer d'adapter cette macro:
(j'ai interprété que tu souhaites copier à la suite de la derniere ligne non vide dans le classeur de destination)

Code :

michel

[patricktoulon]

bonjour

dans l' exemple que tu a donné tu travaille sur 2 classeurs est ce bien le cas pour toi ?

au plaisir

[mercatog]

Bonjour
Ce passage n'est pas clair

alors coupe toute la ligne (qui contient le "x") dans la prochaine ligne non vide de la feuil2, et supprime l’ancienne ligne.

Néanmoins, si tu as plusieurs lignes contenant x en colonne A de Feuil1 que tu veux transférer vers la première ligne vide de Feuil2, il serait plus utile d'utiliser un filtre automatique

Code :

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
Sub Transfert()
Dim LastLig As Long
Dim cDest As Range
 
Application.ScreenUpdating = False
With ThisWorkbook
    'cDest: La celllule de destination: première cellule vide de la colonne A de Feuil2
    With .Worksheets("Feuil2")
        Set cDest = .Cells(.Rows.Count, "A").End(xlUp)(2)
    End With
    With .Worksheets("Feuil1")
        'Enlève l'éventuel filtre automatique
        .AutoFilterMode = False
        'LastLig, ligne de la dernière cellule remplie de colonne A de Feuil1
        LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
        'On fait un filtre automatique sur la colonne A de Feuil1 avec comme critère "x"
        .Range("A1:A" & LastLig).AutoFilter field:=1, Criteria1:="x"
        'Si au moins une ligne résultat du filtre (en plus de la ligne 1 des titres)
        If .Range("A1:A" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then
            With .Range("A2:A" & LastLig).SpecialCells(xlCellTypeVisible).EntireRow
                'On copie toutes les lignes visibles vers cDest (sauf la ligne des titres)
                .Copy cDest
                'on supprime toutes les lignes visibles (sauf la ligne des titres)
                .Delete
            End With
        End If
        'on vide notre variable cDest
        Set cDest = Nothing
        'On enlève le filtre automatique
        .AutoFilterMode = False
    End With
End With
End Sub

Si tu as seulement une seul et unique cellule contenant x en colonne A de Feuil1 et que tu veux transférer cette ligne vers la première cellule vide de colonne A de Feuil2, on passera pas la méthode Find. Exemple:

Code :

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 Transfert2()
Dim c As Range, cDest As Range
 
Application.ScreenUpdating = False
With ThisWorkbook
    'cDest: La celllule de destination: première cellule vide de la colonne A de Feuil2
    With .Worksheets("Feuil2")
        Set cDest = .Cells(.Rows.Count, "A").End(xlUp)(2)
    End With
    With .Worksheets("Feuil1")
    'on cherche LA CELLULE contenant x en colonne A de Feuil1
        Set c = .Range("A:A").Find("x", LookIn:=xlValues, lookat:=xlWhole)
        If Not c Is Nothing Then
            With c.EntireRow
                'On copie toute la ligne trouvée vers cDest
                .Copy cDest
                'on supprime la ligne trouvée de Feuil1
                .Delete
            End With
            Set c = Nothing
        End If
        'on vide notre variable cDest
        Set cDest = Nothing
    End With
End With
End Sub

[moi244]

Merci beaucoup!