XL 2019 Renommer fichier Excel selon valeur d'une cellule

[Bastien43]

Bonsoir,

Question qui peut semblait évidente mais je ne connais pas le code.

Comment renommer un fichier Excel et donc changer son nom selon la valeur d'une cellule contenu dans la première feuille ?

Merci par avance
Cordialement
Bonne soirée
Bastien

 

[fanch55]

Bonjour,
Le fichier Excel est celui qui doit se renommer ( saveas ) ?
Ou ce sont d'autres fichiers excel externes qui doivent être renommés ?

 

[Bastien43]

Bonjour,
Il s'agit du même fichier excel (saveas)
Merci pour votre aide

 

[fanch55]

Testez le classeur joint, la cellule concernée est A1 ( à modifier selon vos besoin )

 

[Bastien43]

Bonjour,

Merci cela fonctionne. J'ai ensuite appliquer ceci à un dossier de plusieurs fichiers excel à renommer (selon la valeur d'une cellule)

Comment faire pour les enregistrer dans un sous-dossier ou bien supprimer les fichiers d'origines ?

je joins le code :

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 & "\Anciens_Fichiers\" & 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

 

[fanch55]

Case Else Wbk.SaveAs Filename

Filename contient le nom du classeur, vous pouvez y ajouter le chemin complet désiré :
Exemple :
Filename = "C: \le dossier que je veux\le sousdossier aussi\" & Trim([E1])

 

[Bastien43]

Ok merci,
Par rapport à la macro du dessus. Comment faire pour que le chemin "C: \le dossier que je veux\le sousdossier aussi\" & Trim([E1]) soit celui ci "Selection_Dossier" du début de la macro ?

C'est à dire créer un sous dossier du dossier obtenu avec la première sélection

merci

 

[fanch55]

Ok merci,
Par rapport à la macro du dessus. Comment faire pour que le chemin "C: \le dossier que je veux\le sousdossier aussi\" & Trim([E1]) soit celui ci "Selection_Dossier" du début de la macro ?

C'est à dire créer un sous dossier du dossier obtenu avec la première sélection

merci

Votre objectif est de :
renommer tous les fichiers d'un dossier ( rétablir leur nom d'origine )
ou de les dupliquer en leur donnant un nouveau nom ( c'est ce que fait le saveas ) ?

 

[Bastien43]

Bonjour,
Au départ, je souhaitais les renommer tous (rétablir leurs noms d'origine).
Cependant si la manip est risquée, je préfère les dupliquer en leur donnant le nouveau nom (issue de la cellule) et en les enregistrant dans un sous-dossier.
Merci

 

[fanch55]

Testez le classeur joint, la cellule de référence est :
Const Target = "E1" dans le module

 

[Bastien43]

Bonjour,
Je vous remercie,
Cela fonctionne parfaitement
Cordialement
Bonne après-midi