Nyt en osaa...

moduuliin...

Option Explicit
'vanhat nimet sarake A
'uudet nimet sarake B
'tiedostopääte .jpg

Sub UudelleenNimeä()
Dim vika As Long
Dim vanha As String
Dim uusi As String
Const POLKU As String = "E:\Testi\"
vika = Range("A65536").End(xlUp).Row
On Error Resume Next
vanha = Dir(POLKU)
Do While vanha ""
Debug.Print vanha
If UCase(Right$(vanha, 3)) = "JPG" Then
uusi = EtsiJaSiirrä(vanha, Columns("A:A")).Offset(0, 1)
If Not uusi = "" Then
Name POLKU & vanha As POLKU & uusi
End If
End If
vanha = Dir
Loop
End Sub

Function EtsiJaSiirrä(Hakuehto As Variant, HakuAlue As Range) As Range
Dim solu As Range
Dim EkaOsoite As String
Worksheets("Kuvat").Activate
With HakuAlue
Set solu = .Find( _
What:=Hakuehto, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not solu Is Nothing Then
Set EtsiJaSiirrä = solu
EkaOsoite = solu.Address
Do
Set EtsiJaSiirrä = Union(EtsiJaSiirrä, solu)
Set solu = .FindNext(solu)
Loop While Not solu Is Nothing And solu.Address EkaOsoite
End If
End With
End Function

Keep EXCELing
@Kunde