Produce multiple spreadshets based on columns

[Beatrix]

Hi Everyone,

I need to create 58 workbooks by filling in 109 cells in each workbook from one spreadsheet to another. Do I need to define each cell value or is there any other method to do it by using array etc?

I attached the sample files.

Cheers
B.

[mancubus]

copy two files and attached file in a folder. create a subfolder in that folder and name as "forms"


attached files contain a sheet named "mapping".
Cell_Address_(Form) are the cells in form to copy corresponding values from source data.
Row_Num_(Source Data) is the row number of that corresponding value in source data.
you may need to review and correct these cell addresses and row numbers.
this table/range is loaded to an array named FormCells. and the code takes form range addresses and source row numbers by accessing this array's elements.

wsF.Range(FormCells(i, 2)).Value = wsS.Cells(FormCells(i, 3), j).Value

in order to test the code with, for example, 3 files change For j = 6 To LastCol to For j = 6 To 8 or to For j = 9 To 11

Sub vbax_54562_Create_Files_From_Source_Data()
    
    Dim wbS As Workbook, wbF As Workbook
    Dim wsS As Worksheet, wsF As Worksheet
    Dim i As Long, j As Long, LastCol As Long, calc As Long
    Dim FormCells
    
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
        .EnableEvents = False
        .AskToUpdateLinks = False
        calc = .Calculation
        .Calculation = xlCalculationManual
    End With
        
    With ThisWorkbook.Worksheets("mapping")
        FormCells = .Cells(1).CurrentRegion.Value
    End With
        
    On Error Resume Next
        Set wbS = Workbooks("vbax_data source.xlsx")
        If wbS Is Nothing Then Set wbS = Workbooks.Open(ThisWorkbook.Path & "\vbax_data source.xlsx")
        Set wsS = wbS.Worksheets("data source")
        LastCol = wsS.Cells(1, Columns.Count).End(xlToLeft).Column
        
        Set wbF = Workbooks("vbax_form.xlsx")
        If Not wbF Is Nothing Then wbF.Close False
    On Error GoTo 0
    
    For j = 6 To LastCol
        Set wbF = Workbooks.Open(ThisWorkbook.Path & "\vbax_form.xlsx")
        Set wsF = wbF.Worksheets("vbax")
        For i = 2 To UBound(FormCells)
            wsF.Range(FormCells(i, 2)).Value = wsS.Cells(FormCells(i, 3), j).Value
        Next i
        wbF.SaveAs Filename:=ThisWorkbook.Path & "\forms\" & wsS.Cells(1, j).Value, FileFormat:=51
        ActiveWorkbook.Close False
    Next j
    
    With Application
        .AskToUpdateLinks = True
        .EnableEvents = True
        .Calculation = calc
    End With
    
End Sub