Comment passer à un autre classeur ?

SendKeys "^a"
ThisWorkbook.Close

Sub NouveauEA()
 Dim Chemin2 As String, Fichier As String
 Dim Rep As Long
 Dim ltexte As String

'------------------------------------------------------------------------
'----------Copie + Incrémentation du Classeur et de la Feuille-----------
'------------------------------------------------------------------------

'Chemin variable de destination du fichier copié obtenu par la commande Concatener
Chemin2 = Range("A11").Value
'Nom variable du fichier à copier obtenu par la commande Concatener
Fichier = Range("A15").Value & ".xls"

'Texte rtf incluant la mise en forme servant à la boite de dialogue suivante
ltexte = "{\rtf1\ansi\ansicpg1252\deff0\deflang1036{\fonttbl{\f0\fdecor\fprq2\fcharset0 Stencil;}{\f1\fswiss\fcharset0 Arial;}{\f2\fswiss\fprq2\fcharset0 Verdana;}{\f3\fnil\fprq2\fcharset2 SansSerif;}}" & _
    "{\colortbl ;\red255\green0\blue0;\red0\green0\blue255;\red0\green255\blue0;}" & _
    "{\*\generator Msftedit 5.41.15.1515;}\viewkind4\uc1\pard\qc\cf1\ul\b\f0\fs44 ATTENTION !\par" & _
    "\cf0\ulnone\b0\f1\fs20\par" & _
    "\f2\fs28 L'Etat d'Acompte servant de base \'e0 l'\'e9tablissement de la \par" & vbCrLf & _
    "prochaine situation de travaux a \'e9t\'e9 modifi\'e9 depuis son ouverture !\par" & vbCrLf & _
    "\par" & vbCrLf & _
    "\cf2\ul Vous devez le sauvegarder pr\'e9alablement pour pouvoir continuer.\par" & vbCrLf & _
    "\cf0\ulnone\par" & vbCrLf & _
    "\b Cette action sera irr\'e9versible,\par" & vbCrLf & _
    "\b0\par" & vbCrLf & _
    "En cas de doute, choisissez \b Non\b0  et controlez si les modifications doivent-\'eatre enregistr\'e9es.\par" & vbCrLf & _
    "\f3\par" & vbCrLf & _
    "\cf3\b\f0\fs40 ENREGISTRER ou NON ?\par" & vbCrLf & _
    "\par" & vbCrLf & _
    "}"
  
'Vérifie que le fichier source a été modifié depuis son ouverture (largeur de la boite fixée à 700 pixels)
If Not ThisWorkbook.Saved Then
    Rep = MsgBoxEx(ltexte, vbCritical + vbYesNo, , , , , 700)
     If Rep = vbNo Then
        Exit Sub
      Else
        ThisWorkbook.Save
    End If
End If
    
'Vérifie que le fichier cible n'existe pas et interroge l'utilisateur si Oui
If Dir(Chemin2 & Fichier) <> "" Then  'le fichier existe
    If MsgBox("Ce fichier existe déjà ! Voulez vous le remplacer ?", vbYesNo) <> vbYes Then Exit Sub
    Application.DisplayAlerts = False 'Message de confirmation désactivé
End If
    'Copie le fichier à l'emplacement spécifié
    ActiveWorkbook.SaveCopyAs Chemin2 & Fichier
    Application.DisplayAlerts = True

'Ouvre le fichier copié
Application.Workbooks.Open Chemin2 & Fichier

'Incrémante le nom de la feuille de 1 sur le fichier copié
Sheets(Range("A16").Value).Select
Sheets(Range("A16").Value).Name = Range("A15").Value

'Lance la macro affectée au raccourcis Crtl+t
SendKeys "^t"

'Ferme le fichier source (False : sans sauvegarde / True : avec sauvegarde)
ThisWorkbook.Close

End Sub