Discussion :

[Jeje8359]

Bonjour à tous, je suis nouveau sur ce forum et je viens déjà solliciter votre aide :-).
J'ai le code suivant qui me copie une sélection d'une Feuille vers une autre feuille.
Si je fais une nouvelle sélection, lors du copier / coller ça m'écrase la précédente copie, je voudrais que ça vienne s'ajouter en dessous.
Merci d'avance pour l'aide que vous pourrez m'apporter.
Bonne journée.
Cordialement.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Private Sub CommandButtonNNO_Click()
Application.ScreenUpdating = False
    Dim xSheet As Worksheet
    Dim ySheet As Worksheet
    Set xSheet = ActiveSheet
    Set ySheet = Sheets("Relance ECM")
        If xSheet.Name <> "Definitions" And xSheet.Name <> "fx" And xSheet.Name <> "Needs" Then
            xSheet.Range("B:M ").Copy
            ySheet.Range("B7:M7 ").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        End If
 
    Application.ScreenUpdating = True
End Sub

[ARTURO83]

Bonjour,

Il faut trouver la dernière ligne de la feuille ySheet et lui ajouter 1.

Code :

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

1
2
Lig_y_Suiv = ySheet.Range("B" & Rows.Count).Row + 1
ySheet.Range("B7:M" & Lig_y_Suiv).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Cdlt

[Jeje8359]

Bonjour,

merci pour votre réponse.

J'ai remplacé ma ligne

Code :

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

ySheet.Range("B7:M7 ").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Par

Code :

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

1
2
Lig_y_Suiv = ySheet.Range("B" & Rows.Count).Row + 1
ySheet.Range("B7:M" & Lig_y_Suiv).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Et j'ai une fenêtre d'erreur d'exécution 1004 : Méthode 'Range' de l'objet '_Worksheet' a échoué.
En mode débogage la 2ème ligne apparait en surbrillance.

[ARTURO83]

Bonjour,

Il faut donner la plage réelle à copier (exemple en rouge), j'ai modifié les 2 lignes suivantes

Code :

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

1
2
3
            xSheet.Range("B7:M10").Copy 
            Lig_y_Suiv = ySheet.Range("B" & Rows.Count).End(xlUp).Row + 1
            ySheet.Range("B" & Lig_y_Suiv).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Cdlt

[Jeje8359]

Rebonjour ARTURO83,

J'ai modifié les 3 lignes. Cette fois-ci plus de message d'erreur mais la zone copiée ne s'incrémente pas dans ma feuille destination (Relance ECM)
J'ai essayé de modifier et de jouer sur les plages mais sans succès.

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
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
    Dim xSheet As Worksheet
    Dim ySheet As Worksheet
    Set xSheet = ActiveSheet
    Set ySheet = Sheets("Relance ECM")
        If xSheet.Name <> "Definitions" And xSheet.Name <> "fx" And xSheet.Name <> "Needs" Then
            'xSheet.Range("B7:M7 ").Copy
            'ySheet.Range("B7:M7 ").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            xSheet.Range("B7:M7").Copy
            Lig_y_Suiv = ySheet.Range("B" & Rows.Count).End(xlUp).Row + 1
            ySheet.Range("B" & Lig_y_Suiv).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        End If
 
Application.ScreenUpdating = True
End Sub

[don_pets]

Hello,

pour coller à la première ligne vide, tu peux aussi partir là-dessus :

Code :

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

1
2
sheets(2).Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteAll, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False