Search code examples
vbaexcelreferencecopy-paste

Copy worksheet template. Add headline in sheet and rename sheet, both from list

I'm trying to make a lot of copies of the same sheet template, where the sheet name and headline needs to be pulled from a list. I've tried illustrating my wishes below.

Basically I have this template where in I've manually renamed the sheet name to 1 and the headline is Test 1: enter image description here

I would like for this to somehow be automated as I have about 136 sheets I need to copy and rename, as well as add a headline. enter image description here

What I'm thinking the steps are: Copy Sheet "1", rename that new sheet from List of Vejnavne to "2", add headline Test 2. Repeat, for 3, 4, 5. etc.

Now the names are not supposed to be test 1, 2.... These are censored, why I need for it too pull data from the lists in Liste med vejnavne. I've stumbled across this codefragment to copy sheets, and it says I will need to rename the sheets instead of "Sheet 1", I'm thinking it must be possible to pull the sheet name from my sheet called "Liste med vejnavne", column A3-A138.

Sub Copier()
    Dim x As Integer

   x = InputBox("Enter number of times to copy active sheet")
   For numtimes = 1 To x
      'Loop by using x as the index number to make x number copies.
      ActiveWorkbook.ActiveSheet.Copy _
         After:=ActiveWorkbook.Sheets("Sheet1")
         'Put copies in front of Sheet1.
         'Replace "Sheet1" with sheet name that you want.
   Next
End Sub
Solution

  • After you copy the sheet, the new copy becomes "active", so you can assign the name you want to that ActiveSheet and also set the value in cell A1.

    Sub Copier()
    Dim x As Long
    Dim numtimes As Long
    Dim wsTemplate As Worksheet

    'Set which sheet is the template
    Set wsTemplate = ActiveSheet

    x = InputBox("Enter number of times to copy active sheet")
    For numtimes = 1 To x
        wsTemplate.Copy After:=ActiveWorkbook.Sheets("Sheet1")
        ActiveSheet.Name = Worksheets("Liste med vejnavne").Cells(numtimes + 2, "A").Value
        ActiveSheet.Cells(1, "A").Value = Worksheets("Liste med vejnavne").Cells(numtimes + 2, "B").Value
   Next
End Sub