Creating multiple sheets with a macro

[syrney170]

I have run into an issue where i want to be able to create multiple
"Resource Plans" sheet with a macro but to have them created as needed
so to speak. I am trying to create a
macro that can be used to see if a sheet called "Resource Plans"
exists. The once it is verified then create an additional sheet called
"Resource Plans-1". Also, I want to it to only
add a planned sheet each time you run the macro but each time to go up
one count numerically within the name of the sheet (i.e. Resource
Plans-1, Resource Plans-2, etc.) I would like to be able to do this for
up to six new sheets.

On each new Resource Plan sheet I want it to copy
the format and the area I define of either the original "Resource
Plans" sheet or of the
previously created Resource Plans sheet, but this part I can probably
figure out myself.

I am not sure if the best way to do this is with if statments or case
arguments or something else. I figure that for the macro to be run
once and create a sheet named
I also know that the second time through it would have to check to see
if "Resource Plans" and "Resource Plans-1" sheets exist to know to add
the next sheet. I hope their is a way to do this in a macro. What I
have been trying to do is not working. I appreciate any help I can get.

Sincerely,
Kyle

Here is my current code in case it helps. I am not sure if I can do it
this way or not. Please let me know if I can do it this way and if so
what changes/additions shoudl I make to the code to make it work.

Sub NewResPlanSh()
'
'

Dim WS As Worksheet

For Each WS In Workbooks(1).Worksheets
Select Case WS.Name
Case Is = "Resource Plans"
Worksheets("Resource Plans").Activate
Range("A1:M26").Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False
Range("J24").Select
Columns("J:J").EntireColumn.AutoFit
Columns("B:B").ColumnWidth = 23.57
Columns("B:B").ColumnWidth = 17.86
Columns("J:J").ColumnWidth = 12
Range("B12:H20").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("C5:J9").Select
Selection.ClearContents
Columns("I:I").ColumnWidth = 12
Columns("B:B").ColumnWidth = 21.57
Range("D16").Select
ActiveSheet.Name = "Resource Plans-1"
Case Is = "Resource Plans-1"
Worksheets("Resource Plans-1").Activate
Range("A1:M26").Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False
Range("J24").Select
Columns("J:J").EntireColumn.AutoFit
Columns("B:B").ColumnWidth = 23.57
Columns("B:B").ColumnWidth = 17.86
Columns("J:J").ColumnWidth = 12
Range("B12:H20").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("C5:J9").Select
Selection.ClearContents
Columns("I:I").ColumnWidth = 12
Columns("B:B").ColumnWidth = 21.57
Range("D16").Select
ActiveSheet.Name = "Resource Plans-2"
Case Is = "Resource Plans-2"
Worksheets("Resource Plans-2").Activate
Range("A1:M26").Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False
Range("J24").Select
Columns("J:J").EntireColumn.AutoFit
Columns("B:B").ColumnWidth = 23.57
Columns("B:B").ColumnWidth = 17.86
Columns("J:J").ColumnWidth = 12
Range("B12:H20").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("C5:J9").Select
Selection.ClearContents
Columns("I:I").ColumnWidth = 12
Columns("B:B").ColumnWidth = 21.57
Range("D16").Select
ActiveSheet.Name = "Resource Plans-3"
End Select
Next WS

End Sub

 

[Robin Hammond]

Kyle,

This will help you with the sheet creation. To use it you would do something
like this:

Sub Name3Sheets()
Dim lCounter as long
For lCounter = 1 to 3
SafelyRenameSheet ActiveWorkbook.Sheets(lCounter), "ResourcePlans"
Next lCounter
End Sub

Sub SafelyRenameSheet(shToName As Worksheet, strName As String)
'renames a sheet either to strName or to strName with a suffix if the
original exists

Dim lSuffix As Long
Dim shTest As Worksheet

On Error GoTo SafelyRenameSheet_Error
lSuffix = 0

With ActiveWorkbook

On Error Resume Next
Set shTest = .Sheets(strName)
On Error GoTo SafelyRenameSheet_Error

If shTest Is Nothing Then

shToName.Name = strName
On Error GoTo 0
Exit Sub

End If

Do While Not shTest Is Nothing

lSuffix = lSuffix + 1

Set shTest = Nothing
On Error Resume Next
Set shTest = .Sheets(strName & CStr(lSuffix))
On Error GoTo SafelyRenameSheet_Error

Loop

shToName.Name = strName & CStr(lSuffix)

End With

EndRoutine:
On Error GoTo 0
Exit Sub

SafelyRenameSheet_Error:
'Error handling code here
Resume EndRoutine
End Sub