XL 2016 Macro pour renommer un fichier, un onglet et ...

Sub Test()
Dim ws As Worksheet, wb As Workbook, fichier As Variant
Set ws = ActiveSheet
fichier = Application.GetOpenFilename("Fichier Excel (*.xls?),*.xls?", , "Choisissez le classeur")
If fichier = False Then Exit Sub
Application.ScreenUpdating = False: Application.DisplayAlerts = False
Set wb = Workbooks.Open(Filename:=fichier)
wb.Sheets("AC25_CARS_2108").Copy After:=Workbooks("Visites.xlsm").Sheets(1)
Xfz = Sheets("AC25_CARS_2108").Name
Sheets("AC25_CARS_2108").Name = Mid(Xfz, 1, Len(Xfz) - 5)
wb.Close False
End Sub

Private Sub CommandButton1_Click()
Dim chemin$, ext$, fichier$, fich$, nomfeuille$
chemin = ThisWorkbook.Path & "\"
ext = ".xlsx" 'extension, modifiable
fichier = "AC25_CARS" & ext
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
Workbooks(fichier).Close False 'si le fichier est ouvert on le ferme
Kill chemin & fichier 'et on le supprime"
fich = Dir(chemin & Replace(fichier, ext, "_????" & ext)) '1er fichier trouvé
Name chemin & fich As chemin & fichier 'renomme le fichier
With Workbooks.Open(chemin & fichier) 'l'ouvre
    nomfeuille = Replace(fichier, ext, "")
    .Sheets(Replace(fich, ext, "")).Name = nomfeuille 'renomme la feuille
    ThisWorkbook.Sheets(nomfeuille).Delete 'supprime la feuille si elle existe
    .Sheets(nomfeuille).Copy Before:=ThisWorkbook.Sheets("TAFF") 'copie la feuille
    .Close True 'enregistre le fichier et le ferme
End With
Sheets("TAFF").Activate
End Sub