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

eeyglunent

XLDnaute Nouveau
Bonjour à tous,

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").RemoveDuplicates 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
 

Pièces jointes

  • RS_SalesALL.xlsx
    30.5 KB · Affichages: 21
  • RoomSeasons_Monthlyperf_HOTELNAME.xlsx
    32.1 KB · Affichages: 30

Discussions similaires

Réponses
12
Affichages
469
Réponses
4
Affichages
426

Statistiques des forums

Discussions
314 711
Messages
2 112 126
Membres
111 430
dernier inscrit
rebmania67