Macro copier / coller

Fermé
Mbugaud - Modifié par Mbugaud le 23/03/2015 à 15:39
Bonjour,
Je viens vers vous pour vous exposer mon problème en VB.
Je veux créer un formulaire (a remplir par un responsable) qui permettrai, une fois le formulaire rempli, effectue une macro qui remplisse un tableau sur une autre feuille du classeur. Donc on rempli le formulaire, on appuie sur le bouton auquel la macro est affectée et les données saisies dans le formulaires se retrouve dans le tableau.
Sauf que, dès que la macro est exécutée plus d'une fois, elle copie les nouveaux renseignements mais remplace également les anciens. La macro crée donc une nouvelle ligne dans le tableau avec les nouvelles informations mais les anciennes changent également. Je ne sais pas si tout cela est très clair pour vous donc je vais également glisser le code VB (peut être cela vous aidera-t-il mieux !).

Code :
Sub Validationformulaire()
'
' Validationformulaire Macro
'

'
Range("G13").Select
Selection.Copy
Sheets("Référencement").Select
Range("Tableau1[Description de l''accident]").Select
ActiveSheet.Paste
Sheets("Formulaire").Select
Range("M13").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Référencement").Select
Range("Tableau1[Mesure(s) mise(s) en place]").Select
ActiveSheet.Paste
Sheets("Formulaire").Select
Range("H9:L9").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Référencement").Select
Range("Tableau1[Date]").Select
ActiveSheet.Paste
Sheets("Noms").Select
Range("G3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Référencement").Select
Range("Tableau1[Rapporteur]").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Noms").Select
Range("G2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Référencement").Select
Range("Tableau1[Victime]").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Services").Select
Range("F2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Référencement").Select
Range("Tableau1[Service de la victime]").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.ListObject.ListRows.Add AlwaysInsert:=True
Range("C3").Select
End Sub


Merci d'avance pour vos réponses !
A voir également: