CODEWITHSUNDEEP
excelvba
JBowen
JBowen

Reputation: 3

How to duplicate a template, populate it with data from another sheet, and rename it from a range within the other sheet without creating Template(2)?

I have the following code to create copies of a template, populate it based on the data within each row of another worksheet and rename it based on the employee in that row. However, I continue to get a sheet named Template(2).

Option Explicit
Sub NewSheets()
    Dim i As Integer
    Dim ws As Worksheet
    Dim sh As Worksheet
    Set ws = Sheets("Template")
    Set sh = Sheets("Employee_Data")
    Application.ScreenUpdating = True

    For i = 2 To Range("B" & Rows.Count).End(xlUp).Row
        Sheets("Template").Copy After:=Sheets(Sheets.Count)
        ActiveSheet.Name = sh.Range("B" & i).Value
        ActiveSheet.Range("C1").Value = sh.Range("A" & i).Value
        ActiveSheet.Range("C2").Value = sh.Range("G" & i).Value
        ActiveSheet.Range("C3").Value = sh.Range("H" & i).Value
        ActiveSheet.Range("C4").Value = sh.Range("I" & i).Value
        ActiveSheet.Range("C5").Value = sh.Range("J" & i).Value
        ActiveSheet.Range("C6").Value = sh.Range("S" & i).Value
        ActiveSheet.Range("C7").Value = sh.Range("V" & i).Value
        ActiveSheet.Range("C8").Value = sh.Range("W" & i).Value
        ActiveSheet.Range("C9").Value = sh.Range("X" & i).Value
        ActiveSheet.Range("C11").Value = sh.Range("L" & i).Value
        ActiveSheet.Range("C12").Value = sh.Range("AH" & i).Value
        ActiveSheet.Range("C13").Value = sh.Range("AJ" & i).Value
        ActiveSheet.Range("C14").Value = sh.Range("AM" & i).Value
        ActiveSheet.Range("C15").Value = sh.Range("AP" & i).Value
        ActiveSheet.Range("C16").Value = sh.Range("AQ" & i).Value
        ActiveSheet.Range("H1").Value = sh.Range("F" & i).Value
        ActiveSheet.Range("H3").Value = sh.Range("K" & i).Value
        ActiveSheet.Range("N1").Value = sh.Range("C" & i).Value
        ActiveSheet.Range("N11").Value = sh.Range("N" & i).Value
    Next i
End Sub

I did find code which would create the multiple copies of the template and rename them as required but I cannot figure out how to write the code needed to populate the template with the data from each row for the specific employee. That code is as follows:

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("Employee_Data").Range("B2")
    Set MyRange = Range(MyRange, MyRange.End(xlDown))
    Sheets("Template").Visible = True

    For Each c In MyRange
        tmp = Trim(c.Value)
        If Len(tmp) > 0 Then dic(tmp) = dic(tmp) + 1
    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

I know I can always delete the extra worksheet but it would be nice if I didn't have too do that as the current project has 13 different groups for this will need to be completed. Any help would be greatly appreciated.

Upvotes: 0

Views: 153

Answers (1)

Tim Williams
Tim Williams

Reputation: 166366

Better to be a little more explicit, and reduce/remove reliance on ActiveSheet:

Option Explicit

Sub NewSheets()
    Dim i As Integer
    Dim ws As Worksheet, wb As Workbook
    Dim sh As Worksheet, wsCopy as worksheet, v

    Set wb = ActiveWorkbook
    Set ws = wb.Sheets("Template")
    Set sh = wb.Sheets("Employee_Data")

    For i = 2 To sh.Range("B" & sh.Rows.Count).End(xlUp).Row

        ws.Copy After:=wb.Sheets(wb.Sheets.Count)
        Set wsCopy = wb.Sheets(wb.Sheets.Count) '<<<< get a reference to the copy

        wsCopy.Name = sh.Range("B" & i).Value
        wsCopy.Range("C1").Value = sh.Range("A" & i).Value

        'EDIT: only copy value if not empty
        v = sh.Range("AJ" & i).Value
        If Len(v) > 0 Then wsCopy.Range("C13").Value = v

        '...
        'snipped for clarity
        '...
        wsCopy.Range("N11").Value = sh.Range("N" & i).Value

    Next i
End Sub

Upvotes: 1

Related Questions