Create macro to duplicate the sheets, make liste and hyperlink-

Chaturvedi, Santosh 590 Reputation points
2026-10-05T14:12:24.6233333+00:00

I have a sheet name as "Data File". It is having the liste of names from C4 till C15.

I want to duplicate sheet name as "Master Template_Collectives" in similar to liste present in "Data File" from C4 till C15.

The duplicated sheets must comes after the "Master Template_Collectives" in similar serial numbetr fashion as mention in "Data File" from C4 till C15.

Then make the liste of newly duplicated sheets in "Data File" starting from cell F4 till end and hyperlink them as well.

Do not delete any existings sheets in workbook.

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

Answer accepted by question author

AI answer

2026-10-05T14:12:43.1166667+00:00

Use a VBA macro that copies the template sheet with Copy After:=..., names each new sheet from Data File!C4:C15, places each copy immediately after the previous one, and writes a hyperlinked list in Data File starting at F4.

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.Hyperlinks.Add _
                Anchor:=wsData.Cells(outRow, "F"), _
                Address:="", _
                SubAddress:="'" & newName & "'!A1", _
                TextToDisplay:=newName
            
            outRow = outRow + 1
        End If
    Next cell
End Sub

What this does:

  1. Reads sheet names from Data File cells C4:C15.
  2. Copies Master Template_Collectives once for each nonblank cell.
  3. Places each new sheet after the previous copied sheet, so the order matches the list.
  4. Leaves existing sheets untouched.
  5. Writes the new sheet names to Data File!F4:F....
  6. Creates hyperlinks in column F to each new sheet.

Notes:

  • If a name in C4:C15 already exists as a worksheet name, renaming the copied sheet will fail.
  • If a name is invalid for Excel sheet names, renaming will fail.
  • This macro does not delete any existing sheets.

The worksheet copy behavior is based on Excel VBA Copy After:=..., which places the copied sheet after the specified sheet.


AI-generated content may be incorrect. Read our transparency notes for more information.

Was this answer helpful?

1 person found this answer helpful.

1 additional answer

Sort by: Most helpful
  1. Chaturvedi, Santosh 590 Reputation points
    2026-10-05T14:15:47.62+00:00

    Please modify this macro so that

    --I want to make the new lsiet algin left

    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.Hyperlinks.Add _
    
                Anchor:=wsData.Cells(outRow, "F"), _
    
                Address:="", _
    
                SubAddress:="'" & newName & "'!A1", _
    
                TextToDisplay:=newName
    
            
    
            outRow = outRow + 1
    
        End If
    
    Next cell
    

    End Sub

    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.