New Worksheets Macro

[Noahthek]

I'm trying to create new worksheets using a Macro.

One of my current worksheets is the layout and formula/data master (we can
call it MasterLayout) and another current worksheet would be where the New
Worksheets are named (MasterName) from an existing list in cells A1:A300; I'd
like each new worksheet to be named from A1, A2, etc.


So that any new worksheets would have the data/layout of MasterLayout and
have the name from MasterName.

How do I do this?

thanks so much for any help,

Noah

 

[ryguy7272]

Try something like this:

Sub add_sheets()
Dim last_row As Long
Dim cell As Range

With ActiveSheet
last_row = .Range("A" & Rows.Count).End(xlUp).Row
For Each cell In .Range("A1:A" & last_row)

ThisWorkbook.Worksheets.Add after:=Worksheets(ThisWorkbook.Worksheets.Count)
ActiveSheet.Name = .Range("A" & cell.Row).Value

Next cell
End With
End Sub


Regards,
Ryan---

 

[Don Guillett]

My question is, why do you need 300 worksheets?
Perhaps one would do with filtering, etc.

 

[Gord Dibben]

Sub CreateNameSheets()
' by Dave Peterson
' List sheetnames required in col A in a sheet: List
' Sub will copy sheets based on the sheet named as: Template
' and name the sheets accordingly

Dim TemplateWks As Worksheet
Dim ListWks As Worksheet
Dim ListRng As Range
Dim myCell As Range

Set TemplateWks = Worksheets("Template")
Set ListWks = Worksheets("list")
With ListWks
Set ListRng = .Range("a1", .Cells(.Rows.Count, "A").End(xlUp))
End With

For Each myCell In ListRng.Cells
TemplateWks.Copy After:=Worksheets(Worksheets.Count)
On Error Resume Next
ActiveSheet.Name = myCell.Value
If Err.Number <> 0 Then
MsgBox "Please fix: " & ActiveSheet.Name
Err.Clear
End If
On Error GoTo 0
Next myCell

End Sub


Gord Dibben MS Excel MVP

 

[Noahthek]

Thank you very much.

It worked reasonably well the first time, stopping after about 50 or 60
worksheets. But then it stopped and no matter how many times I try to
recreate it I get the same error.

This is the section that causes the problem:

TemplateWks.Copy After:=Worksheets(Worksheets.Count)

I receive a run time error 1004; Method 'Copy' of Object'_Worksheet' failed

Maybe there's something I'm missing. I'm relatively new to coding although I
do create simple macros from time to time.

To answer the person who asked if filtering would be an option: Sadly, no.
This report is tracking hours worked on specific projects and each project
needs a separate worksheet. There are about 500 of them.

Thanks,
Noah

Below is the full code:

Sub CreateNameSheets()
' by Dave Peterson
' List sheetnames required in col A in a sheet: MasterAttorney
' Sub will copy sheets based on the sheet named as: MasterMatter
' and name the sheets accordingly

Dim TemplateWks As Worksheet
Dim ListWks As Worksheet
Dim ListRng As Range
Dim myCell As Range

Set TemplateWks = Worksheets("MasterMatter")
Set ListWks = Worksheets("MasterAttorney")
With ListWks
Set ListRng = .Range("a7:a478", .Cells(.Rows.Count, "A").End(xlUp))
End With

For Each myCell In ListRng.Cells
TemplateWks.Copy After:=Worksheets(Worksheets.Count)
On Error Resume Next
ActiveSheet.Name = myCell.Value
If Err.Number <> 0 Then
MsgBox "Please fix: " & ActiveSheet.Name
Err.Clear
End If
On Error GoTo 0
Next myCell

 

[Gord Dibben]

I just tested and the macro copied Template sheet 607 times based on a list
of names in A1:A607 on the sheet named List.

Perhaps you have a duplicate name in your source?


Gord