Copy a command button and its code

[airchris]

Hi everyone,

I'm working on a Excel project for my company. It's nearly over by now but I still cannot find a way to copy a command button and its code to another sheet in the same workbook... it's getting really anoying!!!!
Can someone help me???

Thanks a lot... Chris!

 

[airchris]

Hi everyone,

thanks a lot!! SkipVought already replied to me about this problem so don't mind anymore about it...

Chris

 

[krinid]

airchris,
What was his answer? Can it be done? I'm interested in hearing about that.

 

[ETID]

Yeah,...any way!

 

[airchris]

Hi everyone,

this is the code I used to create a command button that copy a sheet and its code in the same woorkbook. It also rename it:

I want to copy the worksheet("COPRA&quot and rename it.
In this code, Reponse means answer in french, so worksheet(Reponse) is the name you give to the saved sheet;
If you want to use this code, just change worksheet("COPRA&quot by the name of the worksheet you want to save.

Sorry about my english if there are some mistake, I am French and I need some coffee by now!!!

Private Sub CommandButton3_Click()
Dim Sh As Worksheet
Dim Reponse As String
Dim MonNom As String
Dim BonNom As Boolean
Dim Code$, NextLine&
Dim LeString

LeString = ":\/?*[]"

Do
BonNom = True
Reponse = InputBox("Please enter a name" _
+ vbCrLf + "for the new sheet:", _
"Give a name to the sheet", MonNom)
If Reponse <> &quot;&quot; Then
'check if the name already exist
For a = 1 To ActiveWorkbook.Worksheets.Count
If UCase(Reponse) = UCase(Worksheets(a).Name) Then
supp = MsgBox( _
&quot;This sheet already exist,&quot; _
+ vbCrLf + vbCrLf + _
&quot;Do you want to change it?.&quot;, vbYesNo + vbOKOnly, _
&quot;Name already exist&quot
If supp = vbYes Then
Application.DisplayAlerts = False

'Save the informations on the sheet before erasing it
ActiveSheet.Select
ActiveSheet.Cells.Select
Application.Selection.Copy
Worksheets(&quot;COPRA&quot.Activate
Worksheets(&quot;COPRA&quot.Paste
ActiveSheet.Range(&quot;A1&quot.Select
Worksheets(Reponse).Delete
Exit For

Else
BonNom = False
MonNom = Reponse
Exit For
End If
End If
Next

'Check that the number of letters used in the name is under 31 (because this is the limit of Excel)...
If Len(Reponse) > 31 Then
MsgBox &quot;The number of letters(&quot; & _
Len(Reponse) & &quot used in your name is&quot; _
+ vbCrLf + &quot; over the one allowed by Excel.&quot;, _
vbCritical + vbInformation, &quot;Name too long&quot;
BonNom = False
MonNom = Reponse
End If

'Check if you used wrong letters
For a = 1 To Len(LeString)
If InStr(1, Reponse, Mid(LeString, a, 1), vbTextCompare) > 0 Then
MsgBox &quot;The letters: &quot; & _
LeString & &quot; are forbiden&quot; _
+ vbCrLf + &quot;in the name of a worksheet.&quot;, _
vbCritical + vbOKOnly, &quot;Letters forbiden&quot;
BonNom = False
MonNom = Reponse
Exit For
End If
Next
Else
Exit Sub
End If
Loop Until BonNom = True

'Copy the worksheet(&quot;COPRA&quot and rename it
Worksheets(&quot;COPRA&quot.Copy after:=Worksheets(&quot;COPRA&quot
Set Sh = Worksheets(&quot;COPRA (2)&quot
Sh.Name = Reponse
ActiveSheet.Range(&quot;A1&quot.Select

End Sub

I hope this will help many people!!!!

AirChris