>>717
Sub foo(FolderPath As String)
Dim FSO As New FileSystemObject
Dim c As New Collection
Dim Folder As Folder
Dim File As File

FindWord = "*" & Month(Date) & "*"
Set Folder = FSO.GetFolder(FolderPath)
For Each File In Folder.Files
If File.Name Like FindWord Then Exit For
Next
If File Is Nothing Then Exit Sub

s = Split(File.Path, "\")
For i = LBound(s) To UBound(s)
If s(i) Like FindWord Then
e = Split(s(i), ".")
s(i) = Month(DateAdd("m", 1, Date)) & s(1)
End If
FilePath = FilePath & s(i)
If i < UBound(s) Then FilePath = FilePath & "\"
Next

FSO.CopyFile File.Path, FilePath
End Sub

試してないけどこんな感じかなぁ。