Macro to create new worksheet from a template, using data from a master list.

sc0ttish

New Member
Joined
Aug 22, 2007
Messages
37
Office Version
  1. 365
Hello, i've searched google and Mr Excel.....but just cant quite get there.

I have a master list with alot of data.
I am looking for a macro to run to create a new worksheet for each row, copying a template to create the new worksheet.

The new worksheet name would be copied from A3:A400
I've managed to create a macro to do this.

However i then want to use some data from the Master List to populate cells within the new worksheets as they are created.

Master List B3 to populate New Worksheet D1
Master List F3 to populate New Worksheet D2
Master List G3 to populate New Worksheet D3
Master List H3 to populate New Worksheet D4
....of course as new worksheets are created it will move down a row on the Master List to copy over.

So found this code, which creates the new worksheets as expected....but cannot figure out the copying data into the cell.

Thanks.

VBA Code:
Sub SheetsFromTemplate()
    
    Dim wsMaster As Worksheet, wsTemp As Worksheet, wasVisible As Boolean
    Dim shNames As Range, Nm As Range, wsEntry As Worksheet, entryName
    
    With ThisWorkbook
        Set wsTemp = .Sheets("Template")
        wasVisible = (wsTemp.Visible = xlSheetVisible)
        If Not wasVisible Then wsTemp.Visible = xlSheetVisible
        
        Set wsMaster = .Sheets("House List")
    
        Set shNames = wsMaster.Range("A3:A" & Rows.Count).SpecialCells(xlConstants)
        
        Application.ScreenUpdating = False
        For Each Nm In shNames
            entryName = Nm.Text
            Set wsEntry = Nothing 'EDIT
            On Error Resume Next 'ignore error if no sheet with this name
            Set wsEntry = .Sheets(entryName)
            On Error GoTo 0 'stop ignoring errors
            If wsEntry Is Nothing Then
               wsTemp.Copy after:=.Sheets(.Sheets.Count)
               Set wsEntry = .Sheets(.Sheets.Count) 'get the copy
               wsEntry.Name = CStr(Nm.Text)
            End If
            With wsEntry
                'transfer/update values from Master sheet
                .Range("D1").Value = entryOutlet
                '...etc
                wsMaster.Hyperlinks.Add Anchor:=Nm, Address:="", _
                    SubAddress:=wsEntry.Range("B3").Address(, , , True), _
                    TextToDisplay:=Nm.Text
            End With
        Next Nm
        
        wsMaster.Activate
        If Not wasVisible Then wsTemp.Visible = xlSheetHidden
        Application.ScreenUpdating = True
    End With
    MsgBox "Woo hoo, done"
End Sub
 

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
How about:

Change the sheet names "Master list" and "Template" to your own.
VBA Code:
Sub SheetsFromTemplate()
  Dim sh As Worksheet
  Dim c As Range
  
  Application.ScreenUpdating = False
  With Sheets("Master List")
    For Each c In .Range("A3", .Range("A" & Rows.Count).End(3))
      Sheets("Template").Copy after:=Sheets(Sheets.Count)
      Set sh = ActiveSheet
      sh.Name = c.Value
      sh.Range("D1").Value = .Range("B" & c.Row).Value
      sh.Range("D2").Value = .Range("F" & c.Row).Value
      sh.Range("D3").Value = .Range("G" & c.Row).Value
      sh.Range("D4").Value = .Range("H" & c.Row).Value
    Next
  End With
End Sub
 
Upvote 0
How about:

Change the sheet names "Master list" and "Template" to your own.
VBA Code:
Sub SheetsFromTemplate()
  Dim sh As Worksheet
  Dim c As Range
 
  Application.ScreenUpdating = False
  With Sheets("Master List")
    For Each c In .Range("A3", .Range("A" & Rows.Count).End(3))
      Sheets("Template").Copy after:=Sheets(Sheets.Count)
      Set sh = ActiveSheet
      sh.Name = c.Value
      sh.Range("D1").Value = .Range("B" & c.Row).Value
      sh.Range("D2").Value = .Range("F" & c.Row).Value
      sh.Range("D3").Value = .Range("G" & c.Row).Value
      sh.Range("D4").Value = .Range("H" & c.Row).Value
    Next
  End With
End Sub
Hi,

Thanks for the above code this is very useful for me

But the problem I faced is when I add a new row in a Master list, could not able to create a sheet. Could you please solve this
 
Upvote 0
But the problem I faced is when I add a new row in a Master list, could not able to create a sheet. Could you please solve this
Of course the macro already solves that problem, the macro reads all the cells of the "Master list" sheet from cell A3 to the LAST cell with data in column A, As long as you add the data in column A
For Each c In .Range("A3", .Range("A" & Rows.Count).End(3))
 
Upvote 0
Of course the macro already solves that problem, the macro reads all the cells of the "Master list" sheet from cell A3 to the LAST cell with data in column A, As long as you add the data in column A
For example, there are 10 rows in Column A, and run a macro to create the sheets and 10 sheets created. Now I added some data as 11th row in column A, if run again the macro it is showing error 400. please advise. thanks
 
Upvote 0
if run again the macro it is showing error 400
I will explain to you, if you run it again, you must first delete the sheets created, since you cannot create 2 sheets with the same name.
In your original post you did not mention that you are going to run the macro without first deleting the sheets, nor is there an option in your code to delete previously created sheets.

But don't worry, in the following code I added the option to delete the sheet and thus be able to create the new sheet.

VBA Code:
Sub SheetsFromTemplate()
  Dim sh As Worksheet
  Dim c As Range
  
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  
  With Sheets("Master List")
    For Each c In .Range("A3", .Range("A" & Rows.Count).End(3))
      On Error Resume Next: Sheets(c.Text).Delete: On Error GoTo 0
      Sheets("Template").Copy after:=Sheets(Sheets.Count)
      Set sh = ActiveSheet
      sh.Name = c.Value
      sh.Range("D1").Value = .Range("B" & c.Row).Value
      sh.Range("D2").Value = .Range("F" & c.Row).Value
      sh.Range("D3").Value = .Range("G" & c.Row).Value
      sh.Range("D4").Value = .Range("H" & c.Row).Value
    Next
  End With

  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
End Sub
 
Upvote 0
Dear, Thanks for your reply
But the problem is I filled in some information on the created sheets
I have attached my sample file for your reference. In the file Master list is having 5 rows and 5 sheets (with filled information)
If i delete the previously created sheets i will lose the data. Kindly solve

1674329405937.png

1674329458089.png


Sub SheetsFromTemplate()
Dim sh As Worksheet
Dim c As Range

Application.ScreenUpdating = False
With Sheets("Master List")
For Each c In .Range("D6", .Range("D" & Rows.Count).End(3))
Sheets("Template").Copy after:=Sheets(Sheets.Count)
Set sh = ActiveSheet
sh.Name = c.Value
sh.Range("C2").Value = .Range("D" & c.Row).Value
sh.Range("C3").Value = .Range("F" & c.Row).Value
sh.Range("C4").Value = .Range("G" & c.Row).Value
sh.Range("C5").Value = .Range("B" & c.Row).Value
sh.Range("C6").Value = .Range("E" & c.Row).Value
sh.Range("L3").Value = .Range("H" & c.Row).Value
Next
End With
End Sub
 
Upvote 0
Dear, Thanks for your reply
But the problem is I filled in some information on the created sheets
I have attached my sample file for your reference through link. (Link : Example_21-01-2023.xlsm )
In the file, the Master list is having 5 rows and 5 sheetsin the workbook (with filled information)
If I delete the previously created sheets I will lose the data. Kindly advise

Sub SheetsFromTemplate()
Dim sh As Worksheet
Dim c As Range

Application.ScreenUpdating = False
With Sheets("Master List")
For Each c In .Range("D6", .Range("D" & Rows.Count).End(3))
Sheets("Template").Copy after:=Sheets(Sheets.Count)
Set sh = ActiveSheet
sh.Name = c.Value
sh.Range("C2").Value = .Range("D" & c.Row).Value
sh.Range("C3").Value = .Range("F" & c.Row).Value
sh.Range("C4").Value = .Range("G" & c.Row).Value
sh.Range("C5").Value = .Range("B" & c.Row).Value
sh.Range("C6").Value = .Range("E" & c.Row).Value
sh.Range("L3").Value = .Range("H" & c.Row).Value
Next
End With
End Sub
 
Upvote 0

Forum statistics

Threads
1,223,898
Messages
6,175,274
Members
452,628
Latest member
dd2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top