Renombrar archivos

Hola buenas tardes alguien me podria ayudar con esta macro, necesito
renombrar unos archivos diariamente, y he modificado una macro que tenia,
pero no me quedo, alguein me podria ayudar a corregirla, se los agradeceria
mucho.

Sub ww()

Dim Siefore, X As Integer
Dim Nombre, Y As Integer

Siefore = Array("SIEFB1", "SIEFB2", "SIEFB3", "SIEFB4", "SIEFB5", "SIEFAC1")
Nombre = Array("MET1", "MET2", "MET3", "MET4", "MET5", "META")

For X = 0 To UBound(Siefore)
For Y = 0 To UBound(Nombre)
    'ChDir "C:\SIEFB1L\Temp"
    Application.DisplayAlerts = False

FileCopy "C:\" & Siefore(X) & "\TEMP\BALANZA.PRN", "C:\" & Siefore(X) &
"\TEMP\BALANZA " & Nombre(Y) & Format(Date, "dd mmm yyyy") & ".PRN"

    Application.DisplayAlerts = True

    Next
    Next
End Sub

Saludos.