Besoin d'aide sur une macro type "Copier/Coll

Fermé
damaelyon Messages postés 1 Date d'inscription lundi 24 septembre 2012 Statut Membre Dernière intervention 24 septembre 2012 - Modifié par damaelyon le 24/09/2012 à 23:48
Bonjour à tous,

J'ai créé une macro permettant de copier-coller des données d'un tableau source (PLANNING) vers un autre tableau cible (DDV) en dispatchant ces informations sur la totalité de la feuille afin de faire une fiche récapitulative de mes ventes. Cette macro permet d'enregistrer cette cible avec le nom donné en colonne B.

Cependant, ma macro ne fonctionne que pour la première ligne et j'aimerais pouvoir mettre le bouton associé à la macro en colonne O sur l'ensemble des lignes afin de pouvoir créer ma fiche de vente dès que j'ai les informations.

Mais j'y arrive pô.

Voilà mon code :

"Sub Macro1()
'
' Macro1 Macro
'

'
Dim Chemin As String, DDV As String, PLANNING As String

Chemin = ThisWorkbook.Path & "\"
DDV = "DDV.xls"
PLANNING = "PLANNING.xls"

Workbooks.Open Chemin & DDV
Windows(PLANNING).Activate
Range("B2").Select
Selection.Copy
Windows(DDV).Activate
ActiveWindow.SmallScroll Down:=-36
Range("B1:C2").Select
ActiveSheet.Paste
Windows(PLANNING).Activate
Range("C2").Select
Application.CutCopyMode = False
Selection.Copy
Windows(DDV).Activate
Range("D1:E2").Select
ActiveSheet.Paste
Windows(PLANNING).Activate
Range("D2").Select
Application.CutCopyMode = False
Selection.Copy
Windows(DDV).Activate
Range("A4:E4").Select
ActiveSheet.Paste
Windows(PLANNING).Activate
Range("E2").Select
Application.CutCopyMode = False
Selection.Copy
Windows(DDV).Activate
Range("C5").Select
ActiveSheet.Paste
Windows(PLANNING).Activate
Range("F2").Select
Application.CutCopyMode = False
Selection.Copy
Windows(DDV).Activate
Range("E5").Select
ActiveSheet.Paste
Application.CutCopyMode = False

Set FSO = CreateObject("Scripting.FileSystemObject")
Nom = Range("B1") & ".xls"

If ActiveWorkbook.Path = "" Then 'si le document n'a jamais été enregistré
SendKeys Nom
Application.Dialogs(xlDialogSaveAs).Show 'boîte de dialogue Enregistrer sous
Else
If Range("B1") = "" Then MsgBox "Entrez le nom du fichier en B1", 48: Range("B1").Select: Exit Sub
If MsgBox("Voulez-vous enregistrer le fichier sous le nom " & Nom & " ?", 4) = 6 Then
On Error Resume Next
ActiveWorkbook.SaveAs ActiveWorkbook.Path & "\" & Nom 'Enregistre dans le même dossier
If Err Then MsgBox "Le nom proposé contient des caractères interdits", 48: Range("B1").Select
End If
If FSO.FileExists(ActiveWorkbook.Path & "\" & NomFichier) Then
If Nom <> NomFichier And NomFichier <> "DDV.xls" Then Kill ActiveWorkbook.Path & "\" & NomFichier
End If
End If

End Sub"

Merci d'avance pour votre aide.
A voir également: