PDA

View Full Version : Produce multiple spreadshets based on columns



Beatrix
12-16-2015, 06:15 AM
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
12-17-2015, 08:15 AM
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