Classeur modèle et création de feuilles.

Bonsoir le Forum,

j'ai enregistré un modèle de feuille.

Je souhaiterai utiliser ce modèle pour créer des feuilles dans un classeur.

Le code ci-dessous fonctione en partie.
J'ai voulu modifier la fin pour qu'il aille chercher la feuille modèle,
la copie dans le classeur et la renomme.

Le souci est qu'il ne la renomme pas. Elle garde son nom de feuille modèle.

Merci d'avance pour votre aide.
Jipé
______________________________________________


Private Sub CommandButton1_Click()
Dim Sh As Worksheet
Dim Reponse As String
Dim MonNom As String
Dim BonNom As Boolean
Dim LeString
LeString = ":/?*[]"

Do
BonNom = True
Reponse = InputBox("Quel nom désirez-vous donner à la" _
+ vbCrLf + "nouvelle feuille de votre classeur?", _
"Baptisez votre feuille ", MonNom)
If Reponse <> "" Then
'Vérifier que le nom n'existe pas déjà...
For a = 1 To ActiveWorkbook.Worksheets.Count
If UCase(Reponse) = UCase(Worksheets(a).Name) Then
supp = MsgBox( _
"Vous possédez une feuille portant déjà ce nom," _
+ vbCrLf + vbCrLf + _
"Désirez-vous la remplacer?.", vbYesNo + vbOKOnly, _
"Nom existant déjà")
If supp = vbYes Then
Application.DisplayAlerts = False
Worksheets(Reponse).Delete
Application.DisplayAlerts = True
Exit For
Else
BonNom = False
MonNom = Reponse
Exit For
End If
End If
Next

'Vérifier que le nombre de caractères du nom ne dépassent 31...
If Len(Reponse) > 31 Then
MsgBox "Le nombre de caractères (" & _
Len(Reponse) & ") de votre nom dépasse" _
+ vbCrLf + " celui permis (31) par excel.", _
vbCritical + vbInformation, "Nom trop long"
BonNom = False
MonNom = Reponse
End If

'Vérifier l'emploi de caractères interdits...dans le nom
For a = 1 To Len(LeString)
If InStr(1, Reponse, Mid(LeString, a, 1), vbTextCompare) > 0
Then
MsgBox "Les caractères suivants: " & _
LeString & " sont interdits" _
+ vbCrLf + "dans le nom d'une feuille.", _
vbCritical + vbOKOnly, "Caractère interdit"
BonNom = False
MonNom = Reponse
Exit For
End If
Next
Else
Exit Sub
End If
Loop Until BonNom = True

Set Sh = Worksheets.Add(after:=Worksheets(Worksheets.Count))
Sheets.Add after:=Sheets(Sheets.Count), _
Type:=Application.TemplatesPath & "Modèle_notation.xlt"
Sh.Name = Reponse

End Sub
__________________________________________________________

bonjour Jipé,

remplace
Sh.Name = Reponse
par
ActiveSheet.Name = Reponse

et enlève la ligne :
Set Sh = Worksheets.Add(after:=Worksheets(Worksheets.Count))

isabelle

Bonsoir le Forum,

j'ai enregistré un modèle de feuille.

Je souhaiterai utiliser ce modèle pour créer des feuilles dans un
classeur.

Le code ci-dessous fonctione en partie.
J'ai voulu modifier la fin pour qu'il aille chercher la feuille modèle,
la copie dans le classeur et la renomme.

Le souci est qu'il ne la renomme pas. Elle garde son nom de feuille
modèle.

Merci d'avance pour votre aide.
Jipé
______________________________________________


Private Sub CommandButton1_Click()
Dim Sh As Worksheet
Dim Reponse As String
Dim MonNom As String
Dim BonNom As Boolean
Dim LeString
LeString = ":/?*[]"

Do
BonNom = True
Reponse = InputBox("Quel nom désirez-vous donner à la" _
+ vbCrLf + "nouvelle feuille de votre classeur?", _
"Baptisez votre feuille ", MonNom)
If Reponse <> "" Then
'Vérifier que le nom n'existe pas déjà...
For a = 1 To ActiveWorkbook.Worksheets.Count
If UCase(Reponse) = UCase(Worksheets(a).Name) Then
supp = MsgBox( _
"Vous possédez une feuille portant déjà ce nom," _
+ vbCrLf + vbCrLf + _
"Désirez-vous la remplacer?.", vbYesNo + vbOKOnly, _
"Nom existant déjà")
If supp = vbYes Then
Application.DisplayAlerts = False
Worksheets(Reponse).Delete
Application.DisplayAlerts = True
Exit For
Else
BonNom = False
MonNom = Reponse
Exit For
End If
End If
Next

'Vérifier que le nombre de caractères du nom ne dépassent 31...
If Len(Reponse) > 31 Then
MsgBox "Le nombre de caractères (" & _
Len(Reponse) & ") de votre nom dépasse" _
+ vbCrLf + " celui permis (31) par excel.", _
vbCritical + vbInformation, "Nom trop long"
BonNom = False
MonNom = Reponse
End If

'Vérifier l'emploi de caractères interdits...dans le nom
For a = 1 To Len(LeString)
If InStr(1, Reponse, Mid(LeString, a, 1), vbTextCompare) > 0
Then
MsgBox "Les caractères suivants: " & _
LeString & " sont interdits" _
+ vbCrLf + "dans le nom d'une feuille.", _
vbCritical + vbOKOnly, "Caractère interdit"
BonNom = False
MonNom = Reponse
Exit For
End If
Next
Else
Exit Sub
End If
Loop Until BonNom = True

Set Sh = Worksheets.Add(after:=Worksheets(Worksheets.Count))
Sheets.Add after:=Sheets(Sheets.Count), _
Type:=Application.TemplatesPath & "Modèle_notation.xlt"
Sh.Name = Reponse

End Sub
__________________________________________________________