XL 2010 VBA - Bouton lister fichiers et bouton renommer ces fichiers

Sub ListerFichiers()
    Dim Chemin$, Fichier$, Ligne%
    Application.ScreenUpdating = False
    Chemin = [D2]             'Définit le répertoire contenant les fichiers
    'Boucle sur tous les fichiers xls du répertoire.
    Fichier = Dir(Chemin & "*")
    [A:B].ClearContents: Ligne = 1 ' Efface données et Init pointeur écriture
    Do While Len(Fichier) > 0
        'écrit le résultat dans la fenêtre d'exécution (Ctrl+G).
        Cells(Ligne, "A") = Fichier: Ligne = Ligne + 1
        Fichier = Dir()
    Loop
End Sub

Sub RenommerFichiers()
    Dim DL%, L%, Chemin$
    Application.ScreenUpdating = False
    DL = [A65500].End(xlUp).Row: Chemin = [D2] ' Récupère chemin
    For L = 1 To DL
        If Cells(L, "B") <> "" Then
            Name Chemin & Cells(L, "A") As Chemin & Cells(L, "B") ' On renomme le fichier
        End If
    Next L
    [A:B].ClearContents ' On efface les données
    ListerFichiers      ' On remet à jour la liste des fichiers
End Sub