Excel VBA: Generating Multiple Workbooks using a Master Sheet and Template

If you’re given some kind of works template Excel workbook, and you’ve got to populate this works template manually with information, and do this a number of times, you might be thinking, is there a better (easier/lazier) way. And with Excel and Microsoft VBA, of course there is!

The idea of the Macro detailed here, is that we have a Master Sheet which we populate with information required for our work. Then we run a Macro which prompts for which row of information we want to use to populate some kind of works template Excel workbook, and - hey presto - this filled in works template is created. And we can create this filled in template any number of times using our Macro.

The code here also checks the template is open, if not, it opens it, and at the end, it saves it with a specific name (i.e. perhaps you’d want a work order in there or something.)

Image: Excel VBA prompt

Example Macro

You would need to edit this to make it actually do something for you. Still, there is useful knowledge in there worth sharing (or recording for recollection purposes.)

'###############################

'## FUNCTION: CHECK FILE OPEN ##

'###############################

Function CheckFileIsOpen(chkSumfile As String) As Boolean

On Error Resume Next

CheckFileIsOpen = (Workbooks(chkSumfile).Name = chkSumfile)

On Error GoTo 0

End Function

' see https://www.mrexcel.com/forum/excel-questions/431458-vba-code-open-excel-file-only-if-not-already-open.html

'##########################################

'## FUNCTION: TRANSFER TO WORKS TEMPLATE ##

'##########################################

Function Transfer_to_Works(RowNum)

Dim SrcWbk As Workbook

Dim DstWbk As Workbook

'## Load Workbooks

Set SrcWbk = Workbooks("MASTER_SHEET.xlsm")

If CheckFileIsOpen("WORK_TEMPLATE.xlsm") = False Then

Workbooks.Open "W:\WORK ORDERS\" & "WORK_TEMPLATE.xlsm"

End If

Set DstWbk = Workbooks("WORK_TEMPLATE.xlsm")

'## Get data for file name

Dim WORK_DETAIL_1 As String

WORK_DETAIL_1 = SrcWbk.Sheets("MASTER_DATA_SHEET").Range("A" & RowNum)

'## Input data to DstWbk

DstWbk.Sheets("WORK_SHEET_1").Range("E2").Value = SrcWbk.Sheets("MASTER_DATA_SHEET").Range("A" & RowNum)

DstWbk.Sheets("WORK_SHEET_1").Range("E3").Value = "Some value"

DstWbk.Sheets("WORK_SHEET_1").Range("E4").Value = 99

'## and on and on ...

'## Save after edits

DstWbk.SaveAs (("W:\WORK ORDERS\" & WORK_DETAIL_1 & "_WORK_TEMPLATE.xlsm"))

End Function

'##################################################

'## FUNCTION: CONTROL TRANSFER TO WORKS TEMPLATE ##

'##################################################

Sub Control_TTWT()

'## Get row number:

Dim InputRow As Variant

InputRow = InputBox("Enter row number from which to generate work template (or 0 to generate all from row 2 to row 99 - which will take a while)")

If InputRow = 0 Then

  Dim i As Integer

  For i = 2 To 99

    Transfer_to_Works (i)

  Next i

Else

  Transfer_to_Works (InputRow)

End If

End Sub