VBA code to copy template worksheet according to list, list has duplicates

[100_cruiser]

Hi All

new member here!

I have a situation where i need to copy a template tab multiple times, and name these new tabs as per a pre-defined list. I found the below code on this forum

Sub makeSheets()
Dim sh1 As Worksheet, sh2 As Worksheet, c As Range
Set sh1 = Sheets("Template")
Set sh2 = Sheets("Points")
For Each c In sh2.Range("B5", sh2.Cells(Rows.Count, 2).End(xlUp))
sh1.Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = c.Value
Next
End Sub

This works, except for when i get to a point in my reference list where there are duplicate values. What i am looking for is how to make it ignore the duplicates (create the first value) and then move on to the next unique reference in the list

An example of the reference list i am using

any help appreciated

 

[DanteAmor]

Hi and welcome to MrExcel.

Try this:

Sub makeSheets()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim c As Range
  Dim dic As Object, ky As Variant
  
  Set sh1 = Sheets("Template")
  Set sh2 = Sheets("Points")
  Set dic = CreateObject("Scripting.Dictionary")
  
  For Each c In sh2.Range("B5", sh2.Cells(Rows.Count, 2).End(xlUp))
    dic(c.Value) = Empty
  Next
  For Each ky In dic.keys
    sh1.Copy After:=Sheets(Sheets.Count)
    ActiveSheet.Name = ky
  Next
End Sub

 

[100_cruiser]

Hi and welcome to MrExcel.

Try this:

Sub makeSheets()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim c As Range
  Dim dic As Object, ky As Variant
 
  Set sh1 = Sheets("Template")
  Set sh2 = Sheets("Points")
  Set dic = CreateObject("Scripting.Dictionary")
 
  For Each c In sh2.Range("B5", sh2.Cells(Rows.Count, 2).End(xlUp))
    dic(c.Value) = Empty
  Next
  For Each ky In dic.keys
    sh1.Copy After:=Sheets(Sheets.Count)
    ActiveSheet.Name = ky
  Next
End Sub

thankyou so much! that worked great......very much appreciated

 

[DanteAmor]

Im glad to help you. Thanks for the feedback.