View Single Post
  #10   Report Post  
Posted to microsoft.public.excel.misc
Dave Peterson Dave Peterson is offline
external usenet poster
 
Posts: 35,218
Default Create and name multiple sheets

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 _
befo=.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

MikeD1224 wrote:

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?

"Dave Peterson" wrote:

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.

MikeD1224 wrote:

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?

"Gord Dibben" wrote:

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

On Tue, 27 Feb 2007 15:51:08 -0800, MikeD1224
wrote:

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



--

Dave Peterson


--

Dave Peterson