VBA to create Worksheets from Template

[daveasu]

I have a workbook with 2 worksheets. The first worksheet is named "COURSEID" with a list of course IDs, the second worksheet is named "Template" that has formulas. I would like to copy the Template worksheet, and name the copies from a list in COURSEID from A2:A77.

The VBA code below is not naming the worksheets, and it's placing the COURSEID list on each of the copied sheets.

Any suggestions?

Sub AddSheets()    Dim xRg As Excel.Range
    Dim wSh As Excel.Worksheet
    Dim sh1 As Excel.Worksheet
    Dim wBk As Excel.Workbook
    Set wSh = Sheets("COURSEID")
    Set sh1 = Sheets("Template")
    Set wBk = ActiveWorkbook
    Application.ScreenUpdating = False
    For Each xRg In wSh.Range("A2:A77")
        With wBk
            sh1.Copy After:=Sheets(Sheets.Count)
            On Error Resume Next
            ActiveSheet.Name = xRg.Value: wSh.Range("A2:A77") = xRg.Value: ActiveSheet.Range("a1") = xRg.Value
            If Err.Number = 1004 Then
              Debug.Print xRg.Value & " already used as a sheet name"
            End If
            On Error GoTo 0
        End With
    Next xRg
    Application.ScreenUpdating = True
End Sub

 

[AlphaFrog]

Delete the part in red.

Sub AddSheets()    Dim xRg As Excel.Range
    Dim wSh As Excel.Worksheet
    Dim sh1 As Excel.Worksheet
    Dim wBk As Excel.Workbook
    Set wSh = Sheets("COURSEID")
    Set sh1 = Sheets("Template")
    Set wBk = ActiveWorkbook
    Application.ScreenUpdating = False
    For Each xRg In wSh.Range("A2:A77")
        With wBk
            sh1.Copy After:=Sheets(Sheets.Count)
            On Error Resume Next
            ActiveSheet.Name = xRg.Value[COLOR="#FF0000"]: wSh.Range("A2:A77") = xRg.Value[/COLOR]: ActiveSheet.Range("a1") = xRg.Value
            If Err.Number = 1004 Then
              Debug.Print xRg.Value & " already used as a sheet name"
            End If
            On Error GoTo 0
        End With
    Next xRg
    Application.ScreenUpdating = True
End Sub

 

[daveasu]

AlphaFrog, that helped! The worksheets are being created, but only the first worksheet is being named with the corresponding A2 cell in the COURSEID worksheet. The rest of the worksheets are named Template (2), Template (3), etc. In each of the new worksheets, cells A2:A7 are being overwritten with blank cells.

 

[daveasu]

AlphaFrog, that helped! The worksheets are being created, but only the first worksheet is being named with the corresponding A2 cell in the COURSEID worksheet. The rest of the worksheets are named Template (2), Template (3), etc. In each of the new worksheets, cells A2:A7 are being overwritten with blank cells.

Actually it's overwriting A7:A77 sorry for the typo. Any suggestions on what I may be doing wrong? Many thanks.

 

[AlphaFrog]

[COLOR=darkblue]Sub[/COLOR] AddSheets()
    [COLOR=darkblue]Dim[/COLOR] xRg       [COLOR=darkblue]As[/COLOR] Excel.Range
    Application.ScreenUpdating = [COLOR=darkblue]False[/COLOR]
    [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] xRg [COLOR=darkblue]In[/COLOR] Sheets("COURSEID").Range("A2:A77")
        Sheets("Template").Copy After:=Sheets(Sheets.Count)
        ActiveSheet.Name = xRg.Value
        ActiveSheet.Range("A1") = xRg.Value
    [COLOR=darkblue]Next[/COLOR] xRg
    Application.ScreenUpdating = [COLOR=darkblue]True[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

 

[daveasu]

THANK YOU AlphaFrog! That is just what I needed. This process is now working perfectly. (From a fellow Michigan J fan)