Create and name multiple sheets

M

MikeD1224

I currently have a worksheet named 1-1-2007. I need to copy this sheet 60
times and rename each. The names for each sheet are contained on Sheet1
(named "Schedule") and are in column C.

Can I use a macro or an array formula to do this? Any help would be great.

Thanks,

Mike
 
G

Gord Dibben

Mike

Sheet1 will contain your list of names.

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: 1-1-2007
' and name the sheets accordingly

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

Set TemplateWks = Worksheets("1-1-2007")
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
 
M

MikeD1224

Thank you. Works perfect.

Mike
Gord Dibben said:
Mike

Sheet1 will contain your list of names.

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: 1-1-2007
' and name the sheets accordingly

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

Set TemplateWks = Worksheets("1-1-2007")
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
Click to expand...
 
M

MikeD1224

Gord,

Do you also know how I can save each worksheet as a workbook with the name
of the file being derived from the worksheet name?
 
D

Dave Peterson

Option explicit
sub testme()
dim wks as worksheet
for each wks in activewindow.selectedsheets
wks.copy 'to a new workbook
with activesheet
.parent.saveas filename:="C:\temp\" & .name & ".xls", _
fileformat:=xlworkbooknormal
.parent.close savechanges:=false
end with
next wks
end sub

Click on the first sheet tab to be saved and ctrl-click on subsequent. Then run
the macro.
 
M

MikeD1224

Sorry, one last question...

I have a date in cell A2 on each worksheet. The names of my worksheets are
all dates also. Is it possible, that as each sheet is created and renamed,
that I can put the sheet name in cell A2 for that sheet?

Let me know if you have any ideas. Thank you so much.

Mike
 
M

MikeD1224

Can this be tweaked to not only save each worksheet as its own workbook, but
to also save the worksheet called "Schedule" into each workbook as the first
sheet?
 
G

Gord Dibben

Mike

Make changes as such..........

On Error Resume Next
With ActiveSheet
.Name = myCell.Value
.Range("A2").Value = myCell.Value
End With
If Err.Number <> 0 Then


Gord


Wed, 28 Feb 2007 12:05:36 -0800, MikeD1224
 
D

Dave Peterson

Option Explicit
Sub testme()
Dim wks As Worksheet
For Each wks In ActiveWindow.SelectedSheets
Worksheets(Array("schedule", wks.Name)).Copy
With ActiveSheet
.Parent.Worksheets("schedule").Move _
before:=.Parent.Worksheets(1)
With .Parent.Worksheets(wks.Name).Range("A2")
.NumberFormat = "mm/dd/yyyy"
.Value = wks.Name
End With
.Parent.SaveAs Filename:="C:\temp\" & wks.Name & ".xls", _
FileFormat:=xlWorkbookNormal
.Parent.Close savechanges:=False
End With
Next wks
End Sub
 
M

MikeD1224

I'm using the following macro to take the value in cell B2 and save each
worksheet and the worksheet called "Schedule" into their own workbooks. It
keeps hanging at the line that reads ".value = wks.name


Any ideas how to fix this?

Mike



Option Explicit
Sub testme()
Dim wks As Worksheet
For Each wks In ActiveWindow.SelectedSheets
Worksheets(Array("Schedule", wks.Name)).Copy
With ActiveSheet
..Parent.Worksheets("Schedule").Move _
before:=.Parent.Worksheets(1)
With .Parent.Worksheets(wks.Name).Range("B2")
..NumberFormat = "text"
..Value = wks.Name
End With
..Parent.SaveAs Filename:="\\bdfiler\masterads\2007 Master Ad" & wks.Name &
".xls", _
FileFormat:=xlWorkbookNormal
..Parent.Close savechanges:=False
End With
Next wks
End Sub
 
D

Dave Peterson

First, change this line:
..NumberFormat = "text"
to
..NumberFormat = "@"

@ means that the cell should be formatted as text.

Is that worksheet that you're copying protected (with B2 locked)?
 
M

MikeD1224

The error message is

"Run-Time Error 1004: unable to set the NumberFormat Property of the Range
Class. The cell is formatted in the following format: 14-Mar-07.

Dave Peterson said:
And if that doesn't help, what is the error message that you get?
Click to expand...
 
D

Dave Peterson

Is that worksheet that you're copying protected (with B2 locked)?


The error message is

"Run-Time Error 1004: unable to set the NumberFormat Property of the Range
Class. The cell is formatted in the following format: 14-Mar-07.
Click to expand...
 
Top