automate adding sheets
I think I'd drop the list worksheet and just ask for the starting number and how
many.
Option Explicit
Sub CreateNameSheets()
Dim TemplateWks As Worksheet
Dim Start As Long
Dim HowMany As Long
Dim iCtr As Long
Dim NewWks As Worksheet
Dim myName As String
Set TemplateWks = Worksheets("Template")
Start = Application.InputBox(Prompt:="Start with #", Type:=1)
If Start = 0 Then Exit Sub
HowMany = Application.InputBox(Prompt:="How Many More", Type:=1)
If HowMany = 0 Then Exit Sub
If HowMany 100 Then
MsgBox "You're nuts!"
Exit Sub
End If
For iCtr = Start To Start + HowMany
myName = "C8" & Format(iCtr, "000")
If SheetExists(myName, ActiveWorkbook) Then
MsgBox "Sheet: " & myName & " already exists!"
Else
TemplateWks.Copy After:=Worksheets(Worksheets.Count)
Set NewWks = ActiveSheet
With NewWks
'no need for error checking.
'myName is ok and no worksheet with that name exists
.Name = myName
.Range("A2") = myName
End With
End If
Next iCtr
End Sub
Function SheetExists(SheetName As Variant, _
Optional WhichBook As Workbook) As Boolean
'from Chip Pearson
Dim WB As Workbook
Set WB = IIf(WhichBook Is Nothing, ThisWorkbook, WhichBook)
On Error Resume Next
SheetExists = CBool(Len(WB.Worksheets(SheetName).Name) 0)
On Error GoTo 0
End Function
Gord Dibben wrote:
Dave.........HELP!!!
I'll have to work on this for a while but easiest method would be to just change
the list in the list sheet before running the second time.
i.e. delete c8000 to c8099 and replace with c8100 to c8199
For now........amended code with inputbox to enter a number for list sheet A1
Sub CreateNameSheets()
' by Dave Peterson & Gord Dibben
' 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
Dim Start As String
Dim Lrow As Long
Set TemplateWks = Worksheets("Template")
Set ListWks = Worksheets("list")
Lrow = 100
Start = InputBox("enter start number" & vbLf & _
"first run enter 000" & vbLf & _
"subsequent runs, enter last sheet number + 1")
With ListWks
.Columns(1).ClearContents
.Range("A1").Value = "c8" & Start
.Range("A1:A" & Lrow).DataSeries Rowcol:=xlColumns, Type:=xlAutoFill
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
With ActiveSheet
.Name = myCell.Value
.Range("A1") = .Name
End With
If Err.Number < 0 Then
MsgBox "Please fix: " & ActiveSheet.Name
Err.Clear
End If
On Error GoTo 0
Next myCell
End Sub
I'm going to work on returning current lastsheet name to A1 if the macro has
been run once.
Gord
On Wed, 18 Jun 2008 17:18:01 -0700, Brian
wrote:
That works perfect except for 1 thing , if I run the macro again in the same
work book it comes up with a error block . It states fix error in template 2
and it creates sheets named template 2 , template 3 and so on . The macro
does not pick up from the last tab entry. I figured out that you macro
refrences back to the list sheet. But how would I get it to refrence to the
last sheet that was entered by the macro and add 100 more sheets from that
tab name (numbered sequence)and continue assending . The other part is how to
make it reference back
and use the template??
--
Dave Peterson
|