Create new workbook for every sheet in active workbook, starting from Sheet(3) and saving them to a user specified folder location.

Mars84

New Member
Joined
Jun 11, 2022
Messages
3
Office Version
  1. 365
Platform
  1. Windows
Hi team,

Is there anyone that can help me to get my code to work (correctly).

I've only recently started diving into VBA and have been draining the web for code that I mix and match to get the result I need.
After about two weeks of armwrestling with VBA I have managed to produce some useful sheets. That being said, I seem to have bitten off more than I can chew with the code I am trying to write at the moment.

Firstly, I have an "Imports.xlsm" workbook that uses buttons with assigned macros to import a number of user selected text files and adds each text file as a new worksheet starting at Sheet(3).
The first two sheets are fixed as: Sheet(1) = "Instructions" and Sheet(2) = "Summary & Evaluation". Thereafter, the imported sheets are added one-by-one by a macro as:
Sheet(3) = "CA1", Sheet(3) = "CA2", etc.

Secondly, I have created an "EASReportTemplate.xlsm" workbook containing only one sheet ("Sheet1"). This contains the required layout, graphs and formatting required for reporting purposes.

My attempts to code the actions below works for a single data import but I can't get the loop to work correctly and therefor need some assistance.

I need the vba code to do the following upon clicking the "Generate Reports" button:
  1. Prompt user to select the required "EASReportTemplate.xlsm" (I used Application.GetOpenFilename in my code).
  2. Prompt user to select the destination folder where newly created "EAS Reports" will be saved (I used a GetFolder Function I found online).
  3. Prompt user to select the folder containing images with names matching that of each imported data sheet in the "Imports.xlsm". Each image needs to be inserted into the relevant report and automatically be formatted to a certain height or width to fit in the area provided on the sheet. (I haven't tried this yet so I have no idea on how to do it).
  4. Prompt user to enter a reference name or code associated to the EAS Report that will be created. (The same reference will be displayed on all created reports for each set of text files selected in point 2 above.)
  5. Create an EAS Report for each of the named sheets in the "Imports.xlsm" after Sheet(2), thus after Summary & Evaluation.
  6. Each EAS Report must do the following the following: (Starting from Sheet(3).)
    • Clear the selected "EASReportTemplate.xlsm" ranges to be used and reset sheet name to "Sheet1"(incase someone input data into the template file by accident).
    • Auto-populate cell "C3" with the windows login username of the person creating the EAS Reports.
    • Auto-populate cell "L3" with the current date (when the EAS Reports were created/generated).
    • Auto-insert and format image to fit area allowed in cell "N2" (while maintaining the aspect ratio), as proposed in point no.3 in the above mentioned text.
    • Auto-populate cell "D6" with the reference name/number entered in at point no.4 in the above mentioned text.
    • Auto-populate cell "C14" with the sheet name of the relevant sheet in the "Imports.xlsm" workbook.
    • Copy data from Columns A and B on relevant sheet in "Imports.xlsm" (with varying no of rows for each sheet) to paste as values in "EASReportTemplate.xlsm" range "B19" and "C19" (populating cells downward from row 19). B19 contains chainage values (3 decimals) and C19 contains elevation values(3 decimals).
    • Save file with name as Range("C14").Value & "_EAS" & ".xlsm" (and overwrite an existing file with the same name, if already exists is in the selected folder).
    • Save and close the newly created "EAS Report" named CA#_EAS.xlsm.
    • Repeat the process for the next sheet in "Imports.xlsm" workbook, up to the last sheet in that workbook.
  7. The code must be able to handle or display any error that may arise. (not sure how to do this yet)

VBA Code:
Sub BulkGenerateEASReports()

' Declare Variables
Dim wbSource As Workbook ' Imports workbook containing data.
Dim wbTemplate As Workbook ' EASReportTemplate report template.
Dim RefNameNo As String ' Reference name, number or code.
Dim FName As String ' File Name
Dim ws As Worksheet ' Worksheet
Dim SaveAsFldr As Variant

Dim i As Integer

' To speedup Macro
Application.ScreenUpdating = False
Application.EnableEvents = False

Set wbSource = ThisWorkbook ' Set variable to associate with this workbook as reference.


' Select template file to open.
TemplatefileToOpen = Application.GetOpenFilename(FileFilter:="Excel Workbooks (*.xls*),*.xls*", Title:="Select EAS template file to open")
    If TemplatefileToOpen = False Then Exit Sub ' Error handling if no file is selected.

'Select destination folder to save completed EAS report.
SaveAsFldr = GetFolder ' set to Call function.
ChDir SaveAsFldr ' Change directory by calling destination folder function GetFolder.

'Input box for Reference name, number or code.
RefNameNo = Application.InputBox("Please enter relevant reference name.", "Input Required") ' Creates reference to input data.

'Start Loop from here:

For Each ws In wbSource.Worksheets

        If ws.Index <> 3 Then
     
            Set wbTemplate = Workbooks.Open(TemplatefileToOpen) ' Opens the EAS Template file and passes reference for opened workbook.
                
            ' First select ranges in Template file and clear data before importing new data.
            Range("C3:C5, H3:H5, L3:L5, D6, A10:A12, C14, B19:C60000").Select
            Selection.ClearContents
            ActiveSheet.Name = "Sheet1"
            Range("B19").Select
            
            'Import data to template file.
            wbTemplate.Worksheets(1).Range("C3").Value = Environ("username") ' Populate Created By cell.          
            wbTemplate.Worksheets(1).Range("L3").Value = Format(Now, "mm-dd-yy") ' Populate Date created.
            wbTemplate.Worksheets(1).Range("D6").Value = RefNameNo ' Populate Ref. Name.
            wbTemplate.Worksheets(1).Range("C14").Value = wbSource.Sheets(3).Name ' Populate CA# No. cell.
' [Insert Code for importing, sizing and formatting image to "N2" at a later stage. Not sure how to do this yet.]
            wbTemplate.Worksheets(1).Name = wbTemplate.Worksheets(1).Range("C14") ' Populate sheet name with cell value in "C14".
            
' Copy used range from Source to Template sheet.
            wbSource.Sheets(i).UsedRange.Copy ' Copy data.
            wbTemplate.Sheets(1).Range("B19").PasteSpecial Paste:=xlPasteValues ' Paste as values.
        
' Save Template workbook as CA#_EAS.xlms
            Application.DisplayAlerts = False
            'ChDir SaveAsFldr ' Change directory to selected destination folder for completed EAS reports.
            FleName = Range("C14").Value & "_EAS" & ".xlsm"
            wbTemplate.SaveAs FileName:=FleName, FileFormat:=52
            Application.DisplayAlerts = True
            
            'Save and close newly created workbook.
            ActiveWorkbook.Close (False)
    
    End If

Next ws

'End Loop here.
MsgBox "Reporting Completed!"

' Turn on after Macro has run.
Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub



' Function to select destination folder location for saving files as.
'   Function used in Code above.
Function GetFolder() As String
Dim folder As FileDialog
Dim sItem As String
Set folder = Application.FileDialog(msoFileDialogFolderPicker)
    With folder
        .Title = "Select destination folder to save files"
        .AllowMultiSelect = False
    '.InitialFileName = strPath
    If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
GetFolder = sItem
Set folder = Nothing
End Function

Any assistance will be much appreciated.
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.

Forum statistics

Threads
1,214,874
Messages
6,122,034
Members
449,061
Latest member
TheRealJoaquin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top