Sub Renomme()
Dim Cell As Range
Dim MyPath As String
Dim NewName As String
Dim OldName As String
Dim x As Integer
MyPath = "C:\Users\te\Documents\XLD\PourForum\PourForum\Vos_Fichiers_SOURCE\"
''MyPath = Range("A1")
For Each Cell In Range("A2:A" & Range("A65536").End(xlUp).Rows.Row)
OldName = MyPath & Cell.Offset(0, 1)
NewName = MyPath & Cell.Offset(0, 7)
If UCase(Right(NewName, 3)) <> UCase(Right(OldName, 3)) Then
MsgBox NewName & vbCrLf & " Vous ne pouvez pas changer d'extention !", vbExclamation, "Attention !"
Exit Sub
End If
If Dir(OldName) = "" Then
MsgBox OldName & vbCrLf & " n'existe pas !", vbExclamation, "Attention !"
Exit Sub
End If
If Dir(NewName) <> "" Then
MsgBox NewName & vbCrLf & " existe déjà", vbExclamation, "Attention !"
Exit Sub
End If
Name OldName As NewName
x = x + 1
Next
MsgBox x & " fichiers ont été renommés", vbInformation, "Procédure terminée"
End Sub