bonjour à tous Astuciennes et Astuciens

je souhaite copier différentes cellules ( cellules non adjacentes)de ma feuille 1. Par exemple cellule A1, B5, C8, et D2 et les coller sur ma feuille 2 en A2, B2, C2 et D2

Pour l'instant aucun soucis ma macro fonctionne

Par contre quand j'active à nouveau ma macro je souhaite copier les mêmes cellules de ma feuille 1 sur les mêmes colonnes de ma feuille 2 mais une ligne en dessous, c'est à dire A3, B3, C3et D3
et ainsi de suite à chaque fois que j'active ma macro copier une ligne en dessous.

Je suis sur Excel 2007

merci à vous de prendre le temps de me répondre

Vinc391

Bonjour,

Cette macro copie les données de la feuille source vers la première ligne vide de la feuille cible :

Sub Ajout()
Dim i&
Dim WsS As Worksheet 'feuille source
Dim WsC As Worksheet 'feuille cible
Set WsS = Worksheets("Feuil1")
Set WsC = Worksheets("Feuil2")
With WsC i =
.Range("A" & .Columns(1).Cells.Count).End(3).Row
.Cells(i + 1, 1) = WsS.Range("A2")
.Cells(i + 1, 2) = WsS.Range("B6")
.Cells(i + 1, 3) = WsS.Range("C9")
.Cells(i + 1, 4) = WsS.Range("D3")
'et ainsi de suite...
End With
End Sub

Voici un modéle

http://cjoint.com/?3DtkF5f4OCJ

La macro

Sub COPIER_DONNEES()
'
' COPIER_DONNEES Macro
'

'
Sheets("FEUIL1").Select
Range("A1").Select
Selection.Copy
Sheets("Feuil2").Select
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Paste
Sheets("Feuil1").Select
Range("B5").Select
Selection.Copy
Sheets("Feuil2").Select
Range("B1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Paste
Sheets("Feuil1").Select
Range("C8").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Feuil2").Select
Range("C1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Paste
Sheets("Feuil1").Select
Range("D2").Select
Selection.Copy
Sheets("Feuil2").Select
Range("D1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Paste
Sheets("FEUIL1").Select

End Sub

Merci Galopin01 et Philou-10120

c'est exactement ce que je voulais.

Je suis toujours épaté par le forum PC Astuces de l'entraide des astuciennes et astuciens.

Je mets le post comme résolu