Renommer fichier Excel selon valeur d'une cellule

Bonjour Bastien,

Personnellement, je déconseille cette opération, trop risquée à mon goût...

En tout cas, voici un code à tester sur une copie :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" Then
    exfilepath$ = ThisWorkbook.FullName
    RenommerFichier Target.Value
    Kill exfilepath
End If
End Sub

Sub RenommerFichier(skeyword As String)
ThisWorkbook.SaveAs ThisWorkbook.Path & Application.PathSeparator & skeyword & ".xlsm"
End Sub

Le code est à placer dans le module de la feuille qui subira le changement (en A1 ici). Il doit s'agir d'un changement de valeur par saisie et non par formule.

Un nouveau fichier est créé est la copié précédente est supprimée irrémédiablement.

Il manque entre autres, pour le moment, une validation de données car les noms de fichiers excluent certains caractères et une vérification de l'inexistence du nom de fichier dans le répertoire...

Cdlt,

Bonsoir,

Merci cela fonctionne.

Entre temps j'ai souhaité renommer plusieurs fichiers dans un dossier selon le code suivant :

Cependant, comment les enregistrer dans un sous-dossier svp ? Ainsi je conserve les fichiers de départ et les fichiers renommés sont dans le sous-dossier Fichiers_renommés qui est créé à partir du dossier sélectionné au départ.

Merci pour votre aide.

Sub Renommer_nom_d_origine()

On Error Resume Next

   Dim NomFic As String, Wbk As Workbook
   Dim AncienNom As String

   ChDrive "C": ChDir Selection_Dossier ' À adapter
   NomFic = Dir("*.xl*")

   Application.ScreenUpdating = False
   Application.DisplayAlerts = False 'si un fichier est déjà ouvert

   Do While NomFic <> ""
      Set Wbk = Workbooks.Open(NomFic)

      AncienNom = Wbk.Name

      Filename = Trim([E1])

        Select Case True
        Case Filename = vbNullString:                                           'rien
        'Case Filename & ".xlsx" = ThisWorkbook.Name:                            'rien
        'Case MsgBox("Voulez-vous renommer ce classeur : " & AncienNom & vbLf & _
                      " en tant que " & Filename, vbQuestion + vbYesNo) = vbNo:   'rien
        Case Else
        Wbk.SaveAs Filename

        'SelectionDossier & "\Fichiers_Renommés\" & Filename ', xlOpenXMLWorkbookMacroEnabled

        End Select

      Wbk.Close SaveChanges:=True

      NomFic = Dir: Loop

   MsgBox ("Tous les fichiers du dossier sélectionné ont retrouvé leur nom d'origine !")

End Sub

Function Selection_Dossier() As Variant

    '1 ouvrir un fichier
    '2 enregistrement de fichier
    '3 sélection de fichier
    '4 sélection de dossier
    With Application.FileDialog(4)

        .Show
        On Error Resume Next 'si annuler
        Selection_Dossier = .SelectedItems(1)
        If Err.Number <> 0 Then Selection_Dossier = False

    End With

End Function

Re,

Faut-il créer le nouveau sous-dossier ? Faut-il renommer les fichiers d'origine ou juste les copier ?

Cdlt,

Bonsoir

Oui je souhaite créer le sous dossier dans lequel les fichiers excel seront enregistrées.

Leur nom de sauvegarde sont dans la cellule E1.

La macro actuelle me permet de les renommer.

Merci

D'accord, donc le sous-dossier n'existe pas et est à créer et les fichiers sont à renommer. Mais, il serait préférable d'inscrire les nouveaux noms sur Excel probablement plutôt que de laisser l'utilisateur intervenir durant l'exécution de la macro...

Et je n'ai pas bien compris à quoi servait E1.

En tout cas, mon idée est d'utiliser la fonction filecopy pour copier les fichiers sans les ouvrir et d'utiliser mkdir pour créer le sous-dossier, en me passant de boite de dialogue si possible.

Cdlt,

Bonsoir

A oui c'est une possibilité. Je ne connaissais pas mkdir, merci

En fait, je souhaite renommer chaque fichier excel selon le nom contenu dans la cellule E1.

Et les enregistrer vers un sous dossier.

Merci pour votre réponse rapide

C'est bon j'ai réussi grâce à un membre du forum à débloquer la situation, je vous remercie

Merci Bastien du retour et de m'avoir prévenu de la résolution du problème !

Bonne soirée,