Create a new sheet from a template sheet - excel

Question

i have created a vba script which helps me to create new sheets in my workbook every time i enter a new column. What i want to change is to create a new sheet but copying a template sheet for that new sheet.
I basically create a "home sheet" where i will divide the curriculum into lessons, then i want the script to run and create a lesson plan sheet for each lesson. Please can someone help me with this?
Sub add()
Call CreateWorksheets(Sheets("Lesson List").Range("B2:XFD2"))
End Sub
Sub CreateWorksheets(Names_Of_Sheets As Range)
Dim No_Of_Sheets_to_be_Added As Integer
Dim Sheet_Name As String
Dim i As Integer
No_Of_Sheets_to_be_Added = Names_Of_Sheets.Columns.Count
For i = 1 To No_Of_Sheets_to_be_Added
Sheet_Name = Names_Of_Sheets.Cells(1, i).Value
If (Sheet_Exists(Sheet_Name) = False) And (Sheet_Name <> "") Then
Worksheets.add(After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count)).Name = Sheet_Name
End If
Next i
End Sub
Function Sheet_Exists(WorkSheet_Name As String) As Boolean
Dim Work_sheet As Worksheet
Sheet_Exists = False
For Each Work_sheet In ThisWorkbook.Worksheets
If Work_sheet.Name = WorkSheet_Name Then
Sheet_Exists = True
End If
Next
End Function
My edited code with me trying to use the copy function:
Sub add()
Call CreateWorksheets(Sheets("Lesson List").Range("B2:XFD2"))
End Sub
Sub CreateWorksheets(Names_Of_Sheets As Range)
Dim No_Of_Sheets_to_be_Added As Integer
Dim Sheet_Name As String
Dim i As Integer
'determine the number of sheets to create
No_Of_Sheets_to_be_Added = Names_Of_Sheets.Columns.Count
For i = 1 To No_Of_Sheets_to_be_Added
'lable each sheet
Sheet_Name = Names_Of_Sheets.Cells(1, i).Value
If (Sheet_Exists(Sheet_Name) = False) And (Sheet_Name <> "") Then
Worksheets("Lesson Plan Template").Copy After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count).Name = Sheet_Name
End If
Next i
End Sub
Function Sheet_Exists(WorkSheet_Name As String) As Boolean
Dim Work_sheet As Worksheet
Sheet_Exists = False
For Each Work_sheet In ThisWorkbook.Worksheets
If Work_sheet.Name = WorkSheet_Name Then
Sheet_Exists = True
End If
Next
End Function

Answer 1

Although i have not tidy up the error handling and my function as suggested i did follow the suggest of adding additional steps which gave me the desirable results:
Sub Add_New_Lesson()
Call Copy_Lesson_Template(Sheets("Lesson List").Range("B2:XFD2"))
End Sub
Sub Copy_Lesson_Template(Names_Of_Sheets As Range)
Dim No_Of_Sheets_to_be_Added As Integer
Dim Sheet_Name As String
Dim i As Integer
No_Of_Sheets_to_be_Added = Names_Of_Sheets.Columns.Count
For i = 1 To No_Of_Sheets_to_be_Added
Sheet_Name = Names_Of_Sheets.Cells(1, i).Value
If (Sheet_Exists(Sheet_Name) = False) And (Sheet_Name <> "") Then
Worksheets("Lesson Template").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = (Sheet_Name)
End If
Next i
End Sub
Function Sheet_Exists(WorkSheet_Name As String) As Boolean
Dim Work_sheet As Worksheet
Sheet_Exists = False
For Each Work_sheet In ThisWorkbook.Worksheets
If Work_sheet.Name = WorkSheet_Name Then
Sheet_Exists = True
End If
Next
End Function

Answer 2

Check out the following solution including some proper error handling.
Sub CreateWorksheets(Names_Of_Sheets As Range)
'determine the number of sheets to create
Dim No_Of_Sheets_to_be_Added As Long
With Names_Of_Sheets
No_Of_Sheets_to_be_Added = .Resize(ColumnSize:=1).Offset(ColumnOffset:=.Columns.Count - .Column + 1).End(xlToLeft).Column - .Column + 1
End With
Dim i As Long
For i = 1 To No_Of_Sheets_to_be_Added
Dim Sheet_Name As String
Sheet_Name = Names_Of_Sheets.Cells(1, i).Value
If Not Sheet_Exists(Sheet_Name) And Sheet_Name <> vbNullString Then
Dim TemplateCopy As Worksheet
Set TemplateCopy = Nothing 'initialize (needed because we are within a loop)
On Error Goto COPY_TEMPLATE_ERROR 'if error occurs throw message
Set TemplateCopy = Worksheets("Lesson Plan Template").Copy(After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count))
On Error Goto 0 're-enable error handling!
If Not TemplateCopy Is Nothing Then 'check if the template copy exists
On Error Goto RENAME_COPY_ERROR
TemplateCopy.Name = Sheet_Name
On Error Goto 0 're-enable error handling!
End If
End If
Next i
Exit Sub
COPY_TEMPLATE_ERROR:
MsgBox "Template worksheet could not be copied."
Resume
RENAME_COPY_ERROR:
MsgBox "Template could not be renamed to '" & Sheet_Name & "'!"
'remove the template copy that could not be renamed (or you will have orphaned template copys)
Application.DisplayAlerts = False
TemplateCopy.Delete
Application.DisplayAlerts = True
Resume
End Sub
Make sure ActiveWorkbook is what you actually mean it to be:
ActiveWorkbook is the workbook that has focus (is on top of the other windows) while the code runs. This can easily change by a single mouse click.
ThisWorkbook is the workbook this VBA code is written in. It will never change. Use this over ActiveWorkbook when ever possible. This is much more reliable.
Note that if you work with multiple workbooks, every Worksheets or Sheets object needs to start with either ActiveWorkbook.Worksheets, ThisWorkbook.Worksheets or Workbooks("your-workbook-name.xlsm").Worksheets otherwise it is not clear for VBA which one of these you actually mean and it makes a guess (and it might guess wrong).
Finally the name of your function Sheet_Exists is a bit missleading because it only works for Worksheets as it is coded right now. Make sure you know the difference:
Sheets() contains all type of sheets: Worksheet, chart sheet, etc.
Worksheets() only contains sheets of type worksheet.
So your function should be called Worksheet_Exists
Function Worksheet_Exists(WorkSheet_Name As String) As Boolean
Dim Work_sheet As Worksheet
For Each Work_sheet In ThisWorkbook.Worksheets
If Work_sheet.Name = WorkSheet_Name Then
Worksheet_Exists = True
Exit Function 'if we found the name we don't need to check further worksheets
End If
Next Work_sheet
End Function
Or it needs to be changed to work for all type of sheets:
Function Sheet_Exists(Sheet_Name As String) As Boolean
Dim Sheet As Object
For Each Sheet In ThisWorkbook.Sheets
If Sheet.Name = Sheet_Name Then
Sheet_Exists = True
Exit Function 'if we found the name we don't need to check further sheets
End If
Next Sheet
End Function