Modify macro to override if run twice and thrice

Chaturvedi, Santosh 610 Reputation points
2026-10-05T14:31:23.4433333+00:00

I run the following macro, all the sheets duplicated and hyperlinked it is working perfect.

BUT

if in case if I run this macro again and if all the sheets are already present becuase of 1st run then

  1. it should override the existing duplicated sheets and update the liste present in F5 till end again.
  2. It should not duplicate Master Template_Collectives and making two files like Master Template_Collectives & Master Template_Collectives(2)

Please modify for below macro


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 newName As String



Set wsData = ThisWorkbook.Worksheets("Data File")

Set wsTemplate = ThisWorkbook.Worksheets("Master Template_Collectives")

Set copyAfter = wsTemplate



outRow = 4



For Each cell In wsData.Range("C4:C15")

    If Trim(cell.Value) <> "" Then

        newName = CStr(cell.Value)

        

        wsTemplate.Copy After:=copyAfter

        Set wsNew = ActiveSheet

        wsNew.Name = newName

        Set copyAfter = wsNew

        

        wsData.Cells(outRow, "F").Value = newName

        wsData.Cells(outRow, "F").HorizontalAlignment = xlLeft

        

        wsData.Hyperlinks.Add _

            Anchor:=wsData.Cells(outRow, "F"), _

            Address:="", _

            SubAddress:="'" & newName & "'!A1", _

            TextToDisplay:=newName

        

        outRow = outRow + 1

    End If

Next cell

End Sub

Microsoft 365 and Office | Excel | For home | Windows
0 comments No comments

2 answers

Sort by: Most helpful
  1. Thomas4-N 22,390 Reputation points Microsoft External Staff Moderator
    2026-10-09T08:24:43.8633333+00:00

    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:

    Was this answer helpful?

    0 comments No comments

  2. Barry Schwarz 6,271 Reputation points
    2026-10-05T21:36:47.3933333+00:00

    Inside your FOR loop after assigning a value to newName:

    • Check if WorkSheets(newName) exists.
    • If it does, delete it.
    • In either case, you can now create the copy without fear of duplication.

    Was this answer helpful?

    0 comments No comments

Your answer

Answers can be marked as 'Accepted' by the question author and 'Recommended' by moderators, which helps users know the answer solved the author's problem.