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
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