Results 1 to 1 of 1

Thread: VBA - Data extraction, Files creation and Saving

  1. #1

    VBA - Data extraction, Files creation and Saving



    Register for a FREE account, and/
    or Log in to avoid these ads!

    Hi everyone,

    I am coming for your help because I am would like to improve the process I am currently using to extract information from a excel database, generate single excel sheets and save these excel sheets in a folder on my computer.
    Here is some context: For my job, I send a monthly sales report by email to all our clients (100+). To do that, I make an extract from the sales software we have and sort per client in order to get the information for this client only. Then, I copy paste it into the tab1 of a sales report’s template that calculate in tab2 the figures I need. And finally, I save it in my computer and send it by email.
    However, it takes me almost two days to complete the task for all our clients and I guess it would be much faster with a VBA that is able to generate excel files and save it on my laptop… Unfortunately, my level is way too low to write that.. L

    However, during a previous internship, I managed to take a macro that was extracting data from a excel database, that was generating excel files and that was saving them on my laptop. It was extremely efficient but unfortunately, I am not able to modify it..

    Could you please help me to adapt this code in order to make the macro look into my database (file named RS_SalesALL in the attachment), to copy paste it into the tab1 of the sales report template (named Monthlyperf_HOTELNAME in the attachment) and then to save this personnalized sales report in my laptop ?
    I hope my explanations are clear enough and that it is possible to do..

    If someone could help me, I would be sooo grateful!!
    Thanks a lot.


    Attached the documents :
    - RS_SalesALL: Database that gathers all the sales for all the clients
    - RoomSeasons_Monthlyperf_HOTELNAME: Template for the sales report.

    - See below the code of the macro from my previous internship that was doing it super well
    Code:
    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
    Attached Files Attached Files
    Last edited by p45cal; 2015-11-12 at 10:55 PM. Reason: added code tags

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •