Discussion :

[bruno993]

Bonjour,

Novice dans le VBA je cherche actuellement à copier les lignes de ma feuille1 du classeur1, lorsque la condition "oui" apparaît dans la colonne "A". Puis, les supprimer et les coller dans la feuille1 du classeur2, tout en conservant les lignes qui seraient déjà présentes dans la feuille1 du classeur2.


PS: J'avais dans un premier temps utilisé un code tout simple pour copier des lignes d'une feuille1 à une feuille2 du même classeur, pour améliorer ma compréhension. Cependant les lignes existantes de la feuille2 étaient écrasées. Le code ci-dessous.

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
Sub CouperColler()
'definition de la dernière ligne
dernligne = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
k = 2
 
'Condition pour copier/coller
For i = 1 To dernligne
If Sheets(1).Cells(i, 1) = "oui" Then
Sheets(1).Cells(i, 1).EntireRow.Copy Sheets(2).Cells(k, 1)
k = k + 1
End If
Next i
 
'condition pour supprimer
For i = dernligne To 1 Step -1
If Sheets(1).Cells(i, 1) = "oui" Then
Sheets(1).Cells(i, 1).EntireRow.Delete
End If
Next i
End Sub

Merci d'avance de vos réponses

[MarcelG]

Bonjour Bruno,

A mon avis ta variable k est incorrectement initialisée.
Il te faut la définir comme la dernière ligne non informée de la feuille de destination, comme tu l'as fait pour ta feuille initiale (derligne2)

[Menhir]

Il te faut la définir comme la dernière ligne non informée de la feuille de destination, comme tu l'as fait pour ta feuille initiale (derligne2)

En ajoutant +1 au numéro de ligne puisqu'on ne cherche pas la dernière ligne remplie mais la première ligne vide.

[bruno993]

Merci pour vos réponses, j'ai trouvé un autre code qui marche pour copier/coller/supprimer avec condition, des lignes d'une feuille à une autre du même classeur. Code plus bas.

Mais je n'arrive pas à l'adapter pour changer la destination du collage dans une feuille d'un autre classeur.

En résumé je cherche à copier des ligne de la Feuille1 du classeur1, dans la Feuille1 du classeur2.

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
Sub CouperColler_classeur()
 
    Dim r As Long
    Dim derniereLigne As Long
    Dim wks1 As Worksheet
    Dim rng As Range
 
    Set wks1 = Worksheets("Feuille1")
    derniereLigne = wks1.UsedRange.Rows.Count
    For r = derniereLigne To 1 Step -1
        If wks1.Range("A" & r).Value = "oui" Then
            wks1.Cells(r, 1).Resize(1, wks1.UsedRange.Columns.Count).Copy
            Set rng = Worksheets("Feuille2").UsedRange
            If rng.Cells.Count = 1 Then
                rng.PasteSpecial
            Else
                rng.Cells(rng.Rows.Count + 1, 1).PasteSpecial
            End If
            wks1.Cells(r, 1).EntireRow.Delete
        End If
    Next r
End Sub

[vinc_bilb]

Bonjour,

Sans trop rentrer dans le détail du code, je fais quelques remarques / suggestions:

1. Ca peut marcher en absolu mais ça risque d'être très lent (parcours cellule par cellule)
2. Vous utilisez excel? Et bien, profitez-en! Filtrez sur votre valeur "Oui" et récupérer le résultat en une seule passe (en jouant sur le specialcells)

regardez les tuto sur les fonctions filtrages et filtrages avancés, comme https://philippetulliez.developpez.c...dvancedfilter/

Bonne continuation

[MarcelG]

Bonjour à vous, Bonjour au Forum,

Oui, vinc_bilb.
Sauf erreur de ma part.
Dans ce cas les lignes ne sont pas supprimées.
La boîte de dialogue indique "copier vers un autre emplacement"
Ou j'ai peut-être mal lu.

Parallèlement.
Bruno, regarde ce code et reviens pour toute question

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
Sub Marcel_CopierColler_classeur()
 
Dim r As Long
Dim derniereLigne As Long, dernierecol As Long
Dim wks1 As Worksheet, wks2 As Worksheet
Dim k As Long
 
Set wks1 = Worksheets("Feuille1")
Set wks2 = Worksheets("Feuille2")
 
With wks2
 
        k = .Cells(.Rows.Count, 1).End(xlUp).Row
        If k > 1 Then k = k + 1
 
End With
 
With wks1
 
        derniereLigne = .Cells(.Rows.Count, 1).End(xlUp).Row
        dernierecol = .Cells(1, .Columns.Count).End(xlToLeft).Column
 
        For r = derniereLigne To 1 Step -1
                With .Range("A" & r)
                        If .Value = "oui" Then
                                .Resize(1, dernierecol).Copy
                                wks2.Paste Destination:=wks2.Cells(k, 1)
                                Application.CutCopyMode = False
                                .EntireRow.Delete
                                k = k + 1
                        End If
                End With
        Next r
 
End With
 
Set wks1 = Nothing
Set wks2 = Nothing
 
End Sub

[bruno993]

Merci Marcel pour ta réponse.
Le soucis c'est que j'aimerais copier les lignes non pas vers la feuille2 du même classeur mais vers la feuille1 d'un autre classeur.

PS: Pour la copie dans le même classeur c'est ok

Vinc merci pour ta réponse, pour ce qui est de la lenteur ça devrait aller je pense, les lignes à copier ne seront pas nombreuses.
Pour le filtrage avancé, le problème reste le même je n'arrive pas à adapter le code pour copier les lignes du premier classeur vers un autre classeur.