Enregistrer fichier VBA

Bonjour,

J'ai fait le code ci-dessous et l'action enregistrer le fichier «NomFichier.xls» (en gras dans le code) ne fonctionne pas.
En effet, le message d'erreur m'indique « Erreur d'execution `9' :L'indice n'appartient pas à la sélection »

Sub decoupage()
'
' decoupage Macro

'
Dim LigneEntite As Integer
Dim NomFichier As String
Dim NomFichierSmall As String
Dim Entite As String
Dim PieceJointe As String


Dim Message, Objet, Destinataire, CC As String



For LigneEntite = 11 To 29
'Workbooks(cheminficsyn).Activate
'Fitrage et Copie des données par entité
Workbooks("Outil.test1.xls").Sheets("Suivi Utilisateurs").Activate
Entite = Sheets("Synthèse").Range("D" & LigneEntite)
'MsgBox (Entite), vbOKOnly
Sheets("Suivi Utilisateurs").Range("F5").AutoFilter Field:=3, Criteria1:=Entite

DerniereLigne = Range("D65536").End(xlUp).Row
Range("D5:F" & DerniereLigne).Select
Selection.Copy
Workbooks.Add
Sheets("Feuil1").Select
Range("A1").Select
ActiveSheet.Paste

'Cette procédure enregistre le classeur actif sous la valeur de la 'cellule "A1" qui contient "janvier.xls".

NomFichier = Range("C2").Value
ActiveWorkbook.SaveAs "S:\a\b\c\d\Circulation\Test macro\Dernière macro\Dossier\" & NomFichier & ".xls"


'Création du message
Message = Workbooks("Outil.test1.xls").Sheets("Message").Range("A5").Value
Destinataire = Workbooks("Outil.test1.xls").Sheets("Synthèse").Range("B" & LigneEntite).Value
CC = Workbooks("Outil.test1.xls").Sheets("Synthèse").Range("C" & LigneEntite).Value
PieceJointe = "S:\a\b\c\d\Circulation\Test macro\Dernière macro\Dossier\" & NomFichier & ".xls"
Set objOutlook = CreateObject("Outlook.Application")
Set objOutlookMsg = objOutlook.CreateItem(0)
With objOutlookMsg
.To = Destinataire
.CC = CC
.Subject = NomFichierSmall
.Body = Message
.Attachments.Add (PieceJointe)
.Save
End With
ActiveWorkbook.Close
' Next






Workbooks("NomFichier.xls").Close
ActiveSheet.ShowAllData

Next

End Sub







Merci pour votre aide.

Julien