XL 2019 Renommer fichier Excel selon valeur d'une cellule

Bastien43

XLDnaute Occasionnel
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
 

Bastien43

XLDnaute Occasionnel
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

VB:
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
 

Bastien43

XLDnaute Occasionnel
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

XLDnaute Accro
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

XLDnaute Occasionnel
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
 

Discussions similaires

Haut Bas