Copying Macros to new workbooks - excel

Question

Please help, I can run a macro to create multiple new workbooks from a drop down list and save to a specified location . In the original file there are Macros that find specific files and worksheets to place in the file. Is there a way to copy over the Macros to all the new worksheets? I have tried using macros form a personal workbook but they don't seem to work. Thanks

Answer 1

Open a Copy (Template) of ThisWorkbook
This will create a copy (SaveCopyAs) of the workbook containing this code (ThisWorkbook) in an existing folder (FolderPath). Then it will open the copy (OldFilePath) and save it as a template (NewFilePath) and close it. Then it will delete the copy and open the template (LeftBaseName & "Template1").
Option Explicit
Sub OpenMyTemplate()
Const ProcName As String = "OpenMyTemplate"
On Error GoTo ClearError
Const FolderPath As String = "C:\Test" ' adjust this (has to exist)
Const RightBaseName As String = "Template"
Const NewExtension As String = ".xltm"
Dim wbName As String: wbName = ThisWorkbook.Name
Dim DotPosition As Long: DotPosition = InStrRev(wbName, ".")
Dim LeftBaseName As String: LeftBaseName = Left(wbName, DotPosition - 1)
Dim OldExtension As String
OldExtension = Right(wbName, Len(wbName) - DotPosition)
Dim BaseName As String: BaseName = LeftBaseName & RightBaseName
Dim BaseNamePath As String
BaseNamePath = FolderPath & Application.PathSeparator & BaseName
Dim OldFilePath As String: OldFilePath = BaseNamePath & OldExtension
' Save a copy of the workbook containing this code
ThisWorkbook.SaveCopyAs OldFilePath
Dim NewFilePath As String: NewFilePath = BaseNamePath & NewExtension
Application.ScreenUpdating = False
With Workbooks.Open(OldFilePath) ' open the copy
Application.DisplayAlerts = False ' overwrite without confirmation
.SaveAs NewFilePath, xlOpenXMLTemplateMacroEnabled ' save as template
Application.DisplayAlerts = True
.Close SaveChanges:=False
End With
Kill OldFilePath ' delete the copy
Workbooks.Open NewFilePath ' open the template
Application.ScreenUpdating = True
ProcExit:
Exit Sub
ClearError:
Debug.Print "'" & ProcName & "': Unexpected Error!" & vbLf _
& " " & "Run-time error '" & Err.Number & "':" & vbLf _
& " " & Err.Description
Resume ProcExit
End Sub