Multicopy worksheet

[Noepie]

Hello,

I have created a standard scoreform in a worksheet for one contestant. I
would like to create a button so I can fill in the number of contestants (n).
After I filled in the number the macro should automatically copy the standard
scoreform (n-1), because I have already the first worksheet. And to complete
the process the copied worksheets should be numbered 2, 3, and so on (with
the existing standard scoreform already named '1'). Does anyone know how to
achieve this operation with VBE?

Thanx a lot.

Kind regards,

Noepie

 

[Joel]

Sub makecopies()

Set oldsht = Sheets(1)
AddSheets = InputBox("Enter Number of contestants to Add : ")
If IsNumeric(AddSheets) Then
For i = 2 To AddSheets
oldsht.Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = i
Next i
Else
MsgBox ("exiting Sub - Number entered not Numeric")
End If
End Sub

 

[Noepie]

Hi Joel,

Works really great. I have an additional question. Regarding the copying of
the sheets: the command button which copies the scoreform is copied too. Is
it possible to avoid copying of this button into the copies?

Kind regards,

Noepie

 

[Joel]

You can't not copy the control but you can delete it after the sheet is copied

Private Sub CommandButton1_Click()
Set oldsht = Sheets(1)
AddSheets = InputBox("Enter Number of contestants to Add : ")
If IsNumeric(AddSheets) Then
For i = 2 To AddSheets
oldsht.Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = i
For Each obj In ActiveSheet.OLEObjects
obj.Delete
Next obj
Next i
Else
MsgBox ("exiting Sub - Number entered not Numeric")
End If
End Sub

 

[Noepie]

Your solution works, but not in case I protect the sheet which is copied. Can
I add a unprotect command and protect all the added sheets after the removal
of the object?

Many thanks for you help.

Kind regards,
Noepie

 

[Joel]

I don't know if you have a password for protecting the sheets or which
protection object you have set. This code will get you started.


Use as few or as many of these options as you require.
Activesheet.Protect( _
Password:="xyz", _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True, _
UserInterfaceOnly:=True, _
AllowFormattingCells:=True, _
AllowFormattingColumns:=True, _
AllowFormattingRows:=True, _
AllowInsertingColumns:=True, _
AllowInsertingRows:=true, _
AllowInsertingHyperlinks:=True, _
AllowDeletingColumns:=True, _
AllowDeletingRows:=True, _
AllowSorting:=True, _
AllowFiltering:=True, _
AllowUsingPivotTables:=true)



Private Sub CommandButton1_Click()
Set oldsht = Sheets(1)
AddSheets = InputBox("Enter Number of contestants to Add : ")
If IsNumeric(AddSheets) Then
For i = 2 To AddSheets
oldsht.Copy after:=Sheets(Sheets.Count)
With ActiveSheet
.Name = i
.Unprotect
For Each obj In .OLEObjects
obj.Delete
Next obj
.Protect _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True
End With
Next i
Else
MsgBox ("exiting Sub - Number entered not Numeric")
End If
End Sub