Thread: Using a list of names to create new sheets as a template

Ladies & Gentlemen,

I have borrowed some code from David McRichie's site (see below). The code creates a new worksheet based upon a name (in my case a Stock ticker) entered into a column, It also ignores duplicates and places the stock symbol in cell 1A of the newly created sheet.

I can get it to run fine when I manually enter a symbol in the target column, but I need it to work via a copy / paste using a list of stock symbols. Again, it works fine if I copy just one, but it causes an error when I try and copy a list. Also, how can I get this code to copy a customized template(from within the same workbook) and not just add a sheet?

All the Best!
Gregg

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim newSht As String, oldSht  As String
    Dim wsOld As Worksheet, wsNew As Worksheet
    If Target.Column <> 1 Or Target.Row = 6 Then Exit Sub
    oldSht = ActiveSheet.Name
    Set wsNew = ActiveSheet
    newSht = Target.Text
    On Error Resume Next
    Sheets(newSht).Activate
    If Err.Number = 0 Then    'sheetname already exists
       Sheets(oldSht).Activate
       Exit Sub
    End If
    On Error Resume Next
  'Create New Sheet
    Sheets.Add After:=Sheets(Sheets.Count)  '-- place at end
    ActiveSheet.Name = newSht
    Set wsNew = ActiveSheet
    wsNew.Cells(1, 1) = "'" & newSht  'name of new sheet into cell
  '  Sheets(Sheets.Count).Activate  'try to show last tab
    Sheets(oldSht).Activate
End Sub

If you are pasting into the target column more than 1 item you most likely will get an error, because your target count is greater than 1.
an additional error handler may be required

if target.count>1 then exit sub

This will let you paste more then 1 item into the column. Then you will have to so something after to initialize the code again.

Try this:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim r As Range
    Dim cell As Range
    Dim sWks As String

    Set r = Intersect(Target, Columns("A"))
    
    If r Is Nothing Then Exit Sub
    
    For Each cell In r
        sWks = cell.Text
        If SheetExists(sWks) Then
            MsgBox "Sheet already exists: " & sWks, vbOKOnly
        
        ElseIf Not IsValidSheetName(sWks) Then
            MsgBox "Invalid sheet name: " & sWks
            
        Else
            Worksheets("Template").Copy After:=Worksheets(Worksheets.Count)
            With Worksheets(Worksheets.Count)
                .Name = sWks
                .Range("A1") = sWks
                .Visible = xlSheetVisible
            End With
        End If
    Next cell
    
    Me.Select
End Sub

Function SheetExists(sWks As String, _
                     Optional wkb As Workbook = Nothing) As Boolean
    On Error Resume Next
    SheetExists = Not IIf(wkb Is Nothing, ActiveWorkbook, wkb).Sheets(sWks) Is Nothing
    If Err.Number Then Err.Clear
End Function

Function IsValidSheetName(s As String) As Boolean
    If Len(s) = 0 Or Len(s) > 31 Then Exit Function
    If InStr(s, "\") Then Exit Function
    If InStr(s, "/") Then Exit Function
    If InStr(s, ":") Then Exit Function
    If InStr(s, "|") Then Exit Function
    If InStr(s, "*") Then Exit Function
    If InStr(s, "?") Then Exit Function
    IsValidSheetName = True
End Function

There's a bug in Excel that if you try to copy the same worksheet too many times, it falls over, and you have to save, close, and reopen the workbook. This code does not circumvent that, but there are easy ways to.