Option Explicit
Sub Lister()
Dim T(), Fic As String, L As Long
On Error Resume Next
ChDrive [A2].Value: ChDir [A2].Value
If Err Then MsgBox Err.Description, vbCritical, "Lister": Exit Sub
On Error GoTo 0
ActiveSheet.Unprotect "."
ReDim T(1 To 1000, 1 To 1)
Fic = Dir("*")
Do While Fic <> ""
L = L + 1
T(L, 1) = Fic
Fic = Dir
Loop
[A3].Resize(1000).Value = T
ActiveSheet.Protect "."
End Sub
Sub Renommer()
Dim TOrig(), TReno(), L As Long
TOrig = [A3].Resize([A1005].End(xlUp).Row - 2).Value
TReno = [I3].Resize(UBound(TOrig, 1)).Value
On Error Resume Next
ChDrive [A2].Value: ChDir [A2].Value
If Err Then MsgBox Err.Description, vbCritical, "Lister": Exit Sub
For L = 1 To UBound(TOrig, 1)
If TReno(L, 1) <> TOrig(L, 1) And Not IsEmpty(TReno(L, 1)) Then
Err.Clear: Name TOrig(L, 1) As TReno(L, 1)
If Err Then MsgBox "Name """ & TOrig(L, 1) & """ As """ & TReno(L, 1) & """" _
& vbLf & Err.Description, vbExclamation, "Renommer"
Next L
End Sub