Renommer des feuilles et l appliquer à tous les classeurs

Private Sub hakim()
Dim fso As Scripting.FileSystemObject, dossier As Scripting.Folder, fichier As Scripting.File, classeur As Workbook
Dim nomfichier As String, extensionfichier As String
Set fso = New Scripting.FileSystemObject
Set dossier = fso.GetFolder(ThisWorkbook.Path)
For Each fichier In dossier.Files
    nomfichier = fichier.Name
    If nomfichier <> ThisWorkbook.Name Then
        extensionfichier = Right(nomfichier, Len(nomfichier) - InStr(nomfichier, "."))
        If left(nomfichier, 1) <> "~" And Left(extensionfichier, 3) = "xls" Then
            Set classeur = Workbooks.Open(fichier.Path)
            classeur.Sheets(1).Name = nomfichier
            classeur.Save
            Call classeur.Close
        End If
    End If
Next fichier
End Sub