Générer des classeurs personnalisés à partir d'une base

Question

Je fais appel à vos lumières car je souhaiterais automatiser la création de classeurs excel à partir d'une base d'information et mon niveau de VBA ne me le permets pas.. Dans le cadre de mon boulot, j'envoie tous les mois par email un rapport de ventes à nos clients (environ 100 clients). Pour cela, j'extraie sur Excel les infos de ventes de notre logiciel et filtre par client avant de copier ses données dans un autre classeur et enfin d'enregistrer ce classeur sous format "Monthlyperf_CLIENTNAME". Mais l'opération prend beaucoup de temps, sans compter que le nombre de client augmente. Bref, une macro qui permettrait de générer ses fichiers et de les enregistrer me serait d'une grand aide Lors d'un stage précédent, javais récupérer une macro qui génère des fichiers et les enregistre dans un endroit donné. Elle était très efficace mais je ne parviens pas à la modifier.. Pourriez-vous m'aider à l'adapter de manière à ce qu'elle récupère les infos par client dans la base (classeur RS_SalesALL), les copie en dur dans l'onglet 1 d'un autre fichier (ici appelé Monthlyperf_HOTELNAME qui est mon template pour le rapport de vente par client) et enfin enregistre tous ces rapport de ventes dans un dossier de mon ordinateur avec un nom prédéfini? J'ai fait attention à ce que le format de la base et de l'onglet 1 du fichier par client soient le même pour faciliter l'opération. J'espère que mes explications sont assez clairs et que ce n'est pas trop compliqué.. Si quelqu'un peut m'aider, un immense merci! Ci-joint les documents en question: RS_SalesALL: Base qui regroupe toutes les ventes pour tous les clients RoomSeasons_Monthlyperf_HOTELNAME: Fichier par client qui contient en Feuill1 les ventes pour ce client (même format que la base RS_SalesALL) et en feuill2 une analyse de ventes (avec formules donc qui bouge tout seul) Ci-dessous le code de la fameuse macro qui génère des fichiers mais que je n'arrive pas à modifier. Sub SynthèseMR() '0 définition des variables Dim i As Double i = 1 Dim j As Double j = 18 Dim MR As Double MR = 1 Dim p As Double p = 1 Dim q As Double q = 2 Dim Reg As Double Reg = 3 Dim z As Double Dim Feuil As Double Dim Nbmag As Double Dim a As String Dim b As String b = "Début" Dim c As String c = "Début" Dim d As String d = "String" Dim Mois As String Mois = "Mois" Dim mag As String Dim vierge As String Dim dest As String '2 Dimensionnement des macros '2.1 Nombre de lignes du tableau Base Worksheets("Base").Select ActiveSheet.Range("A1").Select Do Until b = fin b = Range("B" & i).Value i = i + 1 Loop i = i - 2 '2.2 Nombre de lignes MR Worksheets("Création").Select Range("A18").Select Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Delete Shift:=xlUp Range("A18").Select Sheets("Base").Select Range("B2:B" & i).Select Selection.Copy Sheets("Création").Select Range("B18").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range(Selection, Selection.End(xlDown)).Select ActiveSheet.Range("$B$18:$D$" & i + 18).RemoveDuplicates Columns:=Array(1, 2, 3), _ Header:=xlNo Application.CutCopyMode = False Range("A1").Select ActiveSheet.Range("$B$18:$D$70000").RemoveDuplicat es Columns:=Array(1, 2, 3), _ Header:=xlNo Range("A1").Select Do Until c = "" c = Range("B" & j).Value j = j + 1 Loop MR = j - 2 '3 création des fichiers MRs a = "début" j = 18 Do Until j = MR a = Worksheets("Création").Range("B" & j).Value vierge = Worksheets("Création").Range("B4").Value dest = Worksheets("Création").Range("B6").Value Sheets("Base").Select Range("A1").Select Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Range(Selection, Selection.End(xlDown)).Select Selection.AutoFilter ActiveSheet.Range("$A$1:$M$70000").AutoFilter Field:=2, Criteria1:= _ a Range("A1").Select Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Workbooks.Open Filename:=vierge Worksheets("Liste").Select Range("B2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Range("A1").Select ChDir _ dest ActiveWorkbook.SaveAs Filename:= _ dest & a & " FAV 2012" _ , FileFormat:=xlExcel8, CreateBackup:=False Range("B2").Select '4 création des feuilles magasins z = 3 mag = 1 Feuil = 3 Do Until mag = "" mag = Range("E" & z).Value z = z + 1 Loop Nbmag = z - 3 z = 3 Do Until z = Nbmag + 2 Worksheets("Liste").Select mag = Range("E" & z).Value Reg = Range("H" & z).Value Worksheets(Feuil).Select ActiveSheet.Name = mag Range("R1") = mag Range("T1") = Reg Workbooks("Base régions.xlsx").Activate Worksheets("Région " & Reg).Select Range("B2").Select Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Workbooks(a & " FAV 2012.xls").Activate Worksheets(mag).Select Range("B2").Select Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False z = z + 1 Feuil = Feuil + 1 Range("A1").Select Loop p = Nbmag + 2 Do Until p = 73 p = p + 1 Application.DisplayAlerts = False Sheets(Nbmag + 2).Delete Application.DisplayAlerts = True Loop ChDir _ dest ActiveWorkbook.Save ActiveWorkbook.Close Workbooks("Moulinette fichiers v4.0.xlsm").Activate Sheets("Base").Select ActiveSheet.Range("$A$1:$M$70000").AutoFilter Field:=2 Range("A1").Select j = j + 1 Loop End Sub...

fred2406 · Accepted Answer

Ci joint un debut de proposition lancement de la macro ctr+maj+C renseigne le fichier source puis renseigner le fichier modele laisser faire creation de l'ensemble des fichiers dans le meme dossier que l'endroit ou se trouve le fichier source pour le nom de fichier j'ai pas tout compris donc a dapter On pourra spécifié un dossier spécifique au besoin plus tard a+ fred...

bouben · Answer

Ci-joint une proposition (similaire sans doute), à tester. Bonne soirée Bouben...