L'Indice n'appartient pas .....

Bonjour,



J'espère que quelqu'un peut m'aider.

J'obtient le message (L'indice n'appartient pas a la sélection), lorsque j'enregistre mon classeur a l'aide d'un VBA

Voici le code

Private Sub Workbook_BeforeClose(Cancel As Boolean)
DeletePopUpMenu
End Sub

Private Sub Workbook_Open()
CreateDisplayPopUpMenu
End Sub

'******************************************************************************
'Procedure permettant de sauvegarder au format Excel Un Formulaire
'dans le dossier actif ayant pour nom la valeur d'une cellule
'******************************************************************************

Sub Archivage()

'Décalration des variables
Dim NomDossier As String
Dim CheminDossier As String

'Gestion des erreurs
Application.DisplayAlerts = False 'On désactive les messages d'alerte
If Range("A3").Value = "" Then 'On teste que le nom du fichier a bien été saisi ou pas
MsgBox "*** Atention *** Vous n'avez pas saisi"
Range("A3").Select
Else ' SINON
Nom = ThisWorkbook.Path & "\" & Range("A3") & UCase(Format([B1], " DD MMMM YYYY"))
flag = 0
chemin = ThisWorkbook.Path & "\"
nom1C = Range("A3") & UCase(Format([B1], " DD MMMM YYYY")) & ".xlsm"
nomFichier = Dir(chemin & "*.xls*")
Do While Len(nomFichier) > 0
If nomFichier = nom1C Then
flag = 1
If flag = 1 Then
rep = InputBox("" & nom1C & " Existe Déjà." & Chr(13) & Chr(13) & "Changez Pour :", nom1C, nom1C)
Exit Sub
End If
End If
nomFichier = Dir
Loop
With ActiveWorkbook 'Enregistrement du classeur portant le nom de la cellule A3
.SaveAs Filename:=ThisWorkbook.Path & "\" & Range("A3") & " " & UCase(Format([B1], "DD MMMM YYYY")), FileFormat:=xlOpenXMLWorkbookMacroEnabled
End With
'On affiche un message informant que le fichier a bien été sauvegardé.
MsgBox "Votre Formulaire Au Nom De *** " & Range("A3") & " " & UCase(Format([B1], "DD MMMM YYYY")) & " *** A Bien Été Enregistré Dans Votre Dossier"
Sheets("Fiche Renseignement").Shapes("Bouton").Delete
End If
Application.DisplayAlerts = True 'On réactive la gestion des alertes.
End Sub


Merci de bien vouloir m'aider

Merci a tous