Hello Chaturvedi, Santosh,
You can delete each previously generated sheet before copying the template again. Also clear the old list in column F before rebuilding it.
Replace your macro with this:
Sub CopyAndListSheets()
Dim wsData As Worksheet
Dim wsTemplate As Worksheet
Dim wsNew As Worksheet
Dim copyAfter As Worksheet
Dim cell As Range
Dim outRow As Long
Dim lastRow As Long
Dim newName As String
On Error GoTo CleanFail
Set wsData = ThisWorkbook.Worksheets("Data File")
Set wsTemplate = ThisWorkbook.Worksheets("Master Template_Collectives")
Set copyAfter = wsTemplate
'Clear the previous list and hyperlinks from F5 downward.
lastRow = wsData.Cells(wsData.Rows.Count, "F").End(xlUp).Row
If lastRow >= 5 Then
wsData.Range("F5:F" & lastRow).Hyperlinks.Delete
wsData.Range("F5:F" & lastRow).ClearContents
End If
outRow = 5
Application.DisplayAlerts = False
Application.ScreenUpdating = False
For Each cell In wsData.Range("C4:C15")
newName = Trim$(CStr(cell.Value))
If newName <> "" Then
'Protect the original worksheets.
If StrComp(newName, wsData.Name, vbTextCompare) = 0 _
Or StrComp(newName, wsTemplate.Name, vbTextCompare) = 0 Then
Err.Raise vbObjectError + 1000, , _
"The name '" & newName & _
"' is reserved for an original worksheet."
End If
'Delete the previous generated sheet if it exists.
If WorksheetExists(newName, ThisWorkbook) Then
ThisWorkbook.Worksheets(newName).Delete
End If
'Create a fresh copy from the original template.
wsTemplate.Copy After:=copyAfter
Set wsNew = ActiveSheet
wsNew.Name = newName
Set copyAfter = wsNew
'Rebuild the list and hyperlink.
With wsData.Cells(outRow, "F")
.Value = newName
.HorizontalAlignment = xlLeft
End With
wsData.Hyperlinks.Add _
Anchor:=wsData.Cells(outRow, "F"), _
Address:="", _
SubAddress:="'" & Replace(newName, "'", "''") & "'!A1", _
TextToDisplay:=newName
outRow = outRow + 1
End If
Next cell
CleanExit:
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Exit Sub
CleanFail:
MsgBox "The macro could not finish: " & Err.Description, _
vbExclamation, "Copy and list sheets"
Resume CleanExit
End Sub
Private Function WorksheetExists( _
ByVal sheetName As String, _
ByVal wb As Workbook) As Boolean
Dim ws As Worksheet
On Error Resume Next
Set ws = wb.Worksheets(sheetName)
On Error GoTo 0
WorksheetExists = Not ws Is Nothing
End Function
This version can be run repeatedly. It deletes and recreates only the generated sheets, while keeping DataFile and MasterTemplate_Collectives unchanged.
Please note that replacing a sheet deletes any manual changes previously made on that generated sheet.
Microsoft references: