Guardar copia del libro en una carpeta con nombre mes y año en curso y nombre del archivo día mes y año

H o l a:

Pon la siguiente macro en el libro "parte diario", cada que quieras una copia ejecuta la macro.

Sub GuardarArchivo()
'Por.Dante Amor
    ruta = "C:\Users\Jesus Garcia\Excel\"
    ruta = "C:\trabajo\"
    mes = Format(Date, "mmmm")
    arch = ThisWorkbook.Name
    p = InStrRev(arch, ".")
    arch = Left(arch, p - 1)
    arch = arch & " " & Format(Date, "dd.mm.yyyy")
    If Dir(ruta & mes, vbDirectory) = "" Then
        MkDir ruta & mes
    End If
    ActiveWorkbook.SaveCopyAs ruta & mes & "\" & arch & ".xlsm"
    MsgBox "Copia creada"
End Sub

Ante todo muy agradecido por tu pronta respuesta, la macro que me enviaste después de modificarla (le he eliminado la línea -ruta = "C:\trabajo\"-) funciona perfectamente,el archivo lo crea sin problemas en la ruta especificada "C:\Users\Jesus Garcia\Excel\septiembre 2015\Parte Diario 04.09.2015.xlsm"

Abusando de tu generosidad ¿se podría crear otra carpeta con el nombre del año? Para que quedara así. Gracias

"C:\Users\Jesus Garcia\Excel\Historico 2015\septiembre 2015\Parte Diario 04.09.2015.xlsm

asi ha quedado la macro

Sub GuardarArchivo()
'Por.Dante Amor
ruta = "C:\Users\Jesus Garcia\Excel\"
mes = Format(Date, "MMMM YYYY")
arch = ThisWorkbook.Name
p = InStrRev(arch, ".")
arch = Left(arch, p - 1)
arch = arch & " " & Format(Date, "dd.mm.yyyy")
If Dir(ruta & mes, vbDirectory) = "" Then
MkDir ruta & mes
End If
ActiveWorkbook.SaveCopyAs ruta & mes & "\" & arch & ".xlsm"
MsgBox "Copia creada"
End Sub