It is not difficult to generate a new workbook using Excel VBA. And there are tons of materials in internet that can teach you how to achieve it. Today I will present something more advanced – how to generate a new workbook that contains a VBA macro using VBA?
Enable Trust Access to VBA Project Object Model
Click on File -> Options to open Excel Optional dialogue. In the navigation pane, select Trust Center -> Trust Center Settings, Trust Center dialogue will be prompted. In the Navigation pane of Trust Center dialogue, click on Macro Settings and then check box before “Trust access to the VBA project object model” and then click OK.
Add Reference Libraries
Press Alt + F9 to get Visual Basic Editor (VBE). Click on Tools -> References to open References – VBAProject dialogue and check box for Microsoft Visual Basic for Applications Extensibility 5.3. Click OK button on the top-right corner to add this reference in your excel file.
Write VBA code into VBE
Though we have named the new worksheet in new workbook as “Test”. We still need to use “Sheet1” in this code Set VBComp = VBProj.VBComponents(“Sheet1”) in order to make the worksheet_change event work.
Sub Generate_Test()
Application.DisplayAlerts = False
Dim MainWB As Workbook
Set MainWB = Workbooks.Add
'Create New Workbook and New Worksheet
MainWB.Worksheets(1).Name = "Test"
With MainWB.Worksheets(1)
.Range("D1:F1").Font.Name = "Arial"
.Range("D1:F1").Font.Color = RGB(0, 0, 0)
.Range("D1:F1").Font.Bold = True
.Range("D1:F10").Borders.Color = RGB(0, 0, 0)
.Range("D1:F1").Interior.Color = RGB(217, 217, 217)
.Range("D1:F1").HorizontalAlignment = xlCenter
.Range("D1:F1").Font.Name = "Arial"
.Range("D1") = "Red"
.Range("E1") = "Green"
.Range("F1") = "Blue"
For i = 2 To 10
.Range("D" & i) = i * 10
.Range("E" & i) = i + 1
.Range("F" & i) = (i + 2) * 10
Next
.Range("A1") = "Column Name"
.Range("A1").Font.Color = RGB(0, 0, 0)
.Range("A1").Font.Bold = True
.Range("A1:A2").Borders.Color = RGB(0, 0, 0)
.Range("A1").Interior.Color = RGB(217, 217, 217)
.Range("A1").HorizontalAlignment = xlCenter
.Range("A1").Font.Name = "Arial"
.Range("A1").ColumnWidth = 15
'Add data validation for cell A1
.Range("A2").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="Red, Green, Blue"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = "Column Name"
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End With
'Add VBA code
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim LineNum As Long
Const DQUOTE = """" ' one " character
Set VBProj = MainWB.VBProject
Set VBComp = VBProj.VBComponents("Sheet1")
Set CodeMod = VBComp.CodeModule
With CodeMod
LineNum = .CountOfLines + 1
.InsertLines LineNum, "Private Sub Worksheet_Change(ByVal Target As Range)"
LineNum = LineNum + 1
.InsertLines LineNum, " Dim KeyCells As Range"
LineNum = LineNum + 1
.InsertLines LineNum, " If Target.Address =" & DQUOTE & "$A$2" & DQUOTE & "Then"
LineNum = LineNum + 1
.InsertLines LineNum, " Set KeyCells = Range(" & DQUOTE & "A2" & DQUOTE & " )"
LineNum = LineNum + 1
.InsertLines LineNum, " Call Column_Click"
LineNum = LineNum + 1
.InsertLines LineNum, " Else"
LineNum = LineNum + 1
.InsertLines LineNum, " Exit Sub"
LineNum = LineNum + 1
.InsertLines LineNum, " End If"
LineNum = LineNum + 1
.InsertLines LineNum, "End Sub"
LineNum = LineNum + 1
.InsertLines LineNum, "Sub Column_Click"
LineNum = LineNum + 1
.InsertLines LineNum, " Value = Trim(ThisWorkbook.Worksheets(1).Range(" & DQUOTE & "$A$2" & DQUOTE & ").Value)"
LineNum = LineNum + 1
.InsertLines LineNum, " If strComp(Value, " & DQUOTE & "Red" & DQUOTE & ")" & "= 0 Then"
LineNum = LineNum + 1
.InsertLines LineNum, " For i = 2 to 10"
LineNum = LineNum + 1
.InsertLines LineNum, " If ThisWorkbook.Worksheets(1).Range(" & DQUOTE & "$D$" & DQUOTE & " & i).Value mod 3 = 0 then "
LineNum = LineNum + 1
.InsertLines LineNum, " ThisWorkbook.Worksheets(1).Range(" & DQUOTE & "$D$" & DQUOTE & " & i).Font.Color = RGB(255, 0, 0) "
LineNum = LineNum + 1
.InsertLines LineNum, " ThisWorkbook.Worksheets(1).Range(" & DQUOTE & "$D$" & DQUOTE & " & i).Font.Bold = True "
LineNum = LineNum + 1
.InsertLines LineNum, " End If "
LineNum = LineNum + 1
.InsertLines LineNum, " Next "
LineNum = LineNum + 1
.InsertLines LineNum, " ElseIf strComp(Value, " & DQUOTE & "Green" & DQUOTE & ")" & "= 0 Then"
LineNum = LineNum + 1
.InsertLines LineNum, " For j = 2 to 10"
LineNum = LineNum + 1
.InsertLines LineNum, " If ThisWorkbook.Worksheets(1).Range(" & DQUOTE & "$E$" & DQUOTE & " & j).Value mod 3 = 0 then "
LineNum = LineNum + 1
.InsertLines LineNum, " ThisWorkbook.Worksheets(1).Range(" & DQUOTE & "$E$" & DQUOTE & " & j).Font.Color = RGB(0, 255, 0) "
LineNum = LineNum + 1
.InsertLines LineNum, " ThisWorkbook.Worksheets(1).Range(" & DQUOTE & "$E$" & DQUOTE & " & j).Font.Bold = True "
LineNum = LineNum + 1
.InsertLines LineNum, " End If "
LineNum = LineNum + 1
.InsertLines LineNum, " Next "
LineNum = LineNum + 1
.InsertLines LineNum, " Else"
LineNum = LineNum + 1
.InsertLines LineNum, " For k = 2 to 10"
LineNum = LineNum + 1
.InsertLines LineNum, " If ThisWorkbook.Worksheets(1).Range(" & DQUOTE & "$F$" & DQUOTE & " & k).Value mod 3 = 0 then "
LineNum = LineNum + 1
.InsertLines LineNum, " ThisWorkbook.Worksheets(1).Range(" & DQUOTE & "$F$" & DQUOTE & " & k).Font.Color = RGB(0, 0, 255) "
LineNum = LineNum + 1
.InsertLines LineNum, " ThisWorkbook.Worksheets(1).Range(" & DQUOTE & "$F$" & DQUOTE & " & k).Font.Bold = True "
LineNum = LineNum + 1
.InsertLines LineNum, " End If "
LineNum = LineNum + 1
.InsertLines LineNum, " Next "
LineNum = LineNum + 1
.InsertLines LineNum, " End If "
LineNum = LineNum + 1
.InsertLines LineNum, "End Sub "
End With
MainWB.Worksheets(1).Activate
MainWB.SaveAs Filename:="D:\Test\Sample.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
MainWB.Save
MainWB.Close SaveChanges:=True
End Sub
Generate New Work
By clicking on “Generated Sample” button showed above, a new excel file called “Sample” will be created. The extension of this newly created excel file is “XLSM”. 
Here are the code written into this excel file by above VBA code.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
If Target.Address = "$A$2" Then
Set KeyCells = Range("A2")
Call Column_Click
Else
Exit Sub
End If
End Sub
Sub Column_Click()
Value = Trim(ThisWorkbook.Worksheets(1).Range("$A$2").Value)
If StrComp(Value, "Red") = 0 Then
For i = 2 To 10
If ThisWorkbook.Worksheets(1).Range("$D$" & i).Value Mod 3 = 0 Then
ThisWorkbook.Worksheets(1).Range("$D$" & i).Font.Color = RGB(255, 0, 0)
ThisWorkbook.Worksheets(1).Range("$D$" & i).Font.Bold = True
End If
Next
ElseIf StrComp(Value, "Green") = 0 Then
For j = 2 To 10
If ThisWorkbook.Worksheets(1).Range("$E$" & j).Value Mod 3 = 0 Then
ThisWorkbook.Worksheets(1).Range("$E$" & j).Font.Color = RGB(0, 255, 0)
ThisWorkbook.Worksheets(1).Range("$E$" & j).Font.Bold = True
End If
Next
Else
For k = 2 To 10
If ThisWorkbook.Worksheets(1).Range("$F$" & k).Value Mod 3 = 0 Then
ThisWorkbook.Worksheets(1).Range("$F$" & k).Font.Color = RGB(0, 0, 255)
ThisWorkbook.Worksheets(1).Range("$F$" & k).Font.Bold = True
End If
Next
End If
End Sub
