XL 2010 creer un classeur a partir d'un autre

Private Sub CommandButton1_Click() 'Valider
TextBox1 = Application.Trim(TextBox1): TextBox2 = Application.Trim(TextBox2)
If TextBox1 = "" Then TextBox1.SetFocus: Exit Sub
If TextBox2 = "" Then TextBox2.SetFocus: Exit Sub
If ComboBox1.ListIndex = -1 Then ComboBox1.DropDown: Exit Sub
Dim chemin$, modele$, fich$, i&
chemin = ThisWorkbook.Path & "\" 'à adapter
modele = "Modele.xltm"
fich = chemin & ComboBox1 & " " & TextBox1 & " Classe " & TextBox2 & ".xlsm" 'à adapter
If fich = ThisWorkbook.FullName Then MsgBox "Vous êtes sur cette classe !", 48: Exit Sub
If OptionButton1 And Dir(fich) <> "" Then MsgBox "Cette classe a déjà été créée...": Exit Sub
If Not OptionButton1 And Dir(fich) = "" Then MsgBox "Il faut créer cette classe...": Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
On Error Resume Next
If OptionButton1 Then
  With Workbooks.Open(chemin & modele)
    With .Sheets("1er Trim")
      .[B1] = TextBox1
      .[Q4] = TextBox2
      .[P3] = ComboBox1
    End With
    .Unprotect "ADMIN"
    For i = 1 To .Sheets.Count
      .Sheets(i).Visible = ThisWorkbook.Sheets(i).Visible
    Next
    .Protect "ADMIN"
    .SaveAs fich, FileFormat:=xlOpenXMLWorkbookMacroEnabled '52
    Application.ScreenUpdating = True
    If Dir(fich) <> "" Then MsgBox "La classe de " & TextBox2 & " a bien été créée..." _
      Else .Close False
  End With
Else
  With Workbooks.Open(fich)
    .Unprotect "ADMIN"
    For i = 1 To .Sheets.Count
      .Sheets(i).Visible = ThisWorkbook.Sheets(i).Visible
    Next
    .Protect "ADMIN"
    .Saved = True 'évite l'invite à la fermeture
  End With
End If
Unload Me 'ferme l'UserForm
Application.EnableEvents = True
End Sub

'---enregistrement et fermeture du fichier---
If ThisWorkbook.Name Like "*xlsm" Then Application.OnTime 1, "Ferme"

Sub Ferme()
ThisWorkbook.Close True
End Sub

Private Sub CommandButton1_Click()
If ThisWorkbook.Name Like "*xlsm" Then UserForm2.Show
End Sub