How to copy a sheet and rename from a list, ignore duplicates

< Back to Search results

 Category: [Excel]  Demo Available 

How to copy a sheet and rename from a list, ignore duplicates




The user has an excel macro that is duplicating a template and renaming the tabs from a list. What the user would like, is to be able to run the macro more than once (i.e. if someone adds to the list) without getting a bug error. So, the user needs to add to this macro to tell excel to just overlook the duplicates and keep going until it gets to the next unique name.

The list the user is using is on a tab called "Opportunity Pipeline" in column A. The tab the user would like to copy and rename is called "Template" - the "Template" is hidden so the user also needs the code to unhide the template, copy it, rename it (multiple times) and then hide it again.

Here is the user's code:

Sub CreateSheetsFromAList()
Dim MyCell, MyRange As Range
Set MyRange = Sheets("Opportunity Pipeline").Range("A3")
Set MyRange = Range(MyRange, MyRange.End(xlDown))
Sheets("Template").Visible = True
For Each MyCell In MyRange
    Sheets("Template").Copy After:=Sheets(Sheets.Count)
    ActiveSheet.Name = MyCell.Value ' renames the new worksheet
Next MyCell
Sheets("Template").Visible = False
End Sub






Sub CreateSheetsFromAList() ' Example Add Worksheets with Unique Names
    Dim MyRange As Range 
    Dim dic As Object, c As Range 
    Dim k As Variant, tmp As String 
    Set dic = CreateObject("scripting.dictionary") 
    Set MyRange = Sheets("Schedule").Range("A11") 
    Set MyRange = Range(MyRange, MyRange.End(xlDown)) 
    Sheets("Template").Visible = True 
    For Each c In MyRange
        ' Test the range to make sure to only deal with non-empty cells .... ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        If c <> "" Then 
          tmp = Trim(c.Value) 
          If Len(tmp) > 0 Then dic(tmp) = dic(tmp) + 1
        End If 
    Next c 
    For Each k In dic.keys 
        If Not WorksheetExists(k) Then 
            Sheets("Template").Copy After:=Sheets(Sheets.Count) 
            ActiveSheet.Name = k ' renames the new worksheet
        End If 
    Next k 
    Sheets("Template").Visible = False 
End Sub 
Public Function WorksheetExists(ByVal WorksheetName As String) As Boolean 
    On Error Resume Next 
    WorksheetExists = (Sheets(WorksheetName).Name <> "") 
    On Error Goto 0 
End Function


Obtained from the OzGrid Help Forum.

Solution provided by Carim.


See also: Index to Excel VBA Code and Index to Excel Freebies and Lesson 1 - Excel Fundamentals and Index to how to… providing a range of solutions and Index to new resources and reference sheets


See also:

How to extract information from a spreadsheet
How to use VBA code to copy Active Row cells to another sheet
How to use VBA code to reference cell to another sheet
How to copy master sheet as values and automatically set new name


Click here to visit our Free 24/7 Excel/VBA Help Forum where there are thousands of posts you can get information from, or you can join the Forum and post your own questions.


stars (0 Reviews)