Aide pour réaliser une macro

LeLutin68 Messages postés 12 Date d'inscription   Statut Membre Dernière intervention   -  
LeLutin68 Messages postés 12 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour à tous et à toutes,

Je souhaite réaliser une macro qui puisse permettre :
1.Copier une valeur d'une liste (sheet1) puis la copier dans la cellule d'une autre feuille (sheet2)
2.imprimer la feuille (sheet2)
3.Copier la valeur suivante de la liste (sheet1) dans la feuille (sheet2)
3.imprimer la feuille (sheet2)
etc.... jusqu'à fin de la liste.

Le principe est que j'ai un formulaire dans la feuille (sheet1) qui se met à jour automatique quand je renseigne une donnée dans une cellule (R7), je souhaiterai qu'il puisse se mettre à jour automatiquement + impression en utilisant les données présentes dans la colonne A de la feuille (sheet2)..

Pourriez vous m'aider à réaliser ma première macro ?:)

Voici le principe pour une valeur (je souhaite que cela puisse s'enchainer pour toute les valeurs de la liste)

'Sub Macro1()

Sheets("sheet2").Activate 'Active la feuille où se trouve ma liste
Range("A1").Select 'Sélection de la première valeur de ma liste
Application.CutCopyMode = False
Selection.Copy 'Copie de la première valeur de ma liste
Sheets("sheet1").Activate 'Active la feuille où se trouve mon formulaire
Range("R7").Select 'Selectionne la cellule à mettre à jour
ActiveSheet.Paste 'Colle la valeur de ma liste
ActiveSheet.PrintOut 'Imprime le formulaire

End Sub

Merci d'avance & bonne journée

Alexandre
A voir également:

1 réponse

Gyrus Messages postés 3334 Date d'inscription   Statut Membre Dernière intervention   526
 
Bonjour,

Sub Test()
Dim WsS As Worksheet 'Feuille source
Dim WsC As Worksheet 'Feuille cible
Dim Cel As Range
Set WsS = Worksheets("sheet2") 'feuille où se trouve la liste
Set WsC = Worksheets("sheet1") ''feuille où se trouve le formulaire
For Each Cel In WsS.Range("A1:A" & WsS.Range("A" & Rows.Count).End(xlUp).Row)
Cel.Copy WsC.Range("R7")
WsC.PrintOut
Next Cel
Set WsC = Nothing: Set WsS = Nothing
End Sub


A+
0
LeLutin68 Messages postés 12 Date d'inscription   Statut Membre Dernière intervention  
 
Merci infiniment Gyrus ! qu'elle efficacité
Ça fonctionne à merveille :)

Bonne journée et encore merci :)
0