できた
ちゃんと動くかどうかテストしてないんでバックアップとってな

Sub CopyLastFile()
　　TargetFolder = "C:\"　　' 処理するフォルダ
　　If Right(TargetFolder, 1) <> "\" Then TargetFolder = TargetFolder & "\"
　　Set Dirs = CreateObject("Scripting.FileSystemObject").GetFolder(TargetFolder).SubFolders
　　For Each CurrentFolder In Dirs
　　　　If CurrentFolder.Name <> "最後" And CurrentFolder.Name <> "System Volume Information" Then
　　　　　　MaxName = ""
　　　　　　FName = Dir(TargetFolder & CurrentFolder.Name & "\*.jpg")
　　　　　　Do While FName <> ""
　　　　　　　　If FName > MaxName Then MaxName = FName
　　　　　　　　FName = Dir()
　　　　　　Loop
　　　　　　If MaxName <> "" Then　　' ファイルを移動
　　　　　　　　Name TargetFolder & CurrentFolder.Name & "\" & MaxName As TargetFolder & "最後" & "\" & MaxName
　　　　　　End If
　　　　End If
　　Next
End Sub