Workbook Generator based on template and data list

[mclau152]

I'm looking to make a workbook generator in VBA which creates a new workbook, copies and pastes a template from sheet1 of the original (select all and copy paste), and then takes data from sheet 2 which is organized in a list and pastes it in a corresponding cell.

This script would run down the list of data and create a new workbook for as many cells there were in the lists.

Here's the first part of the script, a function I found online to acquire the data in one column of sheet2 and put them in a list to be used in each workbook generated:

Function GetFileNames() As Variant
    Dim WSD As Worksheet
    Set WSD = Worksheets("Sheet2")
    
    Dim FinalRow As Long
    FinalRow = WSD.Cells(Application.Rows.Count, 1).End(xlUp).Row
    
    Dim Result() As String
    
    Dim j As Long
    Dim i As Integer
    
    i = 1
    
    For j = 2 To FinalRow
    
        ReDim Preserve Result(1 To i)
        Result(i) = WSD.Cells(j, 1).Value
        i = i + 1
    
    Next j
    GetFileNames = Result
    
End Function

Now that the data in that list is stored, it can be used to fill in one of the criteria of the newly created workbook.

Here's the code I have that uses the data from GetFileNames function to save the newly created workbook as (File Name).xlsx, also based on the code I got from the last function

Sub WorkBooksLoop()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim FileNames() As String
    FileNames = GetFileNames()
    
    On Error GoTo NoFileNames
    
    Dim ControllerWb As Workbook  'Controller workbook is main workbook with template and data lists
    Set ControllerWb = ActiveWorkbook
    Dim wb As Workbook
    Dim fname As Variant

    'Save to location specified
    Dim Location As String
    Location = "C:\DATA\MYDOCUMENTS\"  
    
    'Or use this to save in same location
    'Dim rootpath As String
    'rootpath = ThisWorkbook.Path
    'rootpath = rootpath & "\"
    
    
    
    For Each fname In FileNames
        ControllerWb.Activate
        
        On Error Resume Next
        
        
        Workbooks.Add
        
        
        
        If Err <> 0 Then
            Set wb = Workbooks.Add
            
            
        Else
           
        End If
        
        

        ActiveWorkbook.SaveAs Filename:=Location + fname & ".xlsx"

        
        Workbooks("WorkbookGenerator.xlsm").Worksheets("Sheet1").Cells.Copy
        
        ActiveWorkbook.Worksheets("Sheet1").Paste
        
        
        
        
        
        
        
        
            
        'Save and close the active workbook
        ActiveWorkbook.SaveAs Filename:=Location + fname & ".xlsx"
        ActiveWorkbook.Close
        
    'Open next workbook and repeat process
    Next fname
    
NoFileNames:
End Sub

This code will create new workbooks for all the data you have in column A of Sheet2, copy and paste the data from Sheet1, and then save the file as whatever is in the corresponding row of Column A as it moves down the list.


Now I would like to be able to perhaps have Column B of Sheet2 have a list of names that will be placed in cell E4 of each of the workbooks created, these names should only go in the workbook that they are next to in the list. Would the process be the same but simply use another function like GetFileNames to acquire the names in the list as fName was taken? Is there a better way to acquire data from multiple lists and have them all be applied the way fName is?

Or is there simply a better way to do all of this, I am perhaps complicating it too much.

Thank you.