Editar macro Excel para guardar archivo en SubCarpeta

Dante Feliz año nuevo 2016

Vengo con esta tu macro para que me la edites para lo siguiente

Sub guardar_Copia() 'PARA GUARDAR COMO XLSX
'Por.Dante Amor http://www.todoexpertos.com/preguntas/6fxnalqm9tyxkxdd/en-macro-excel-copiar-el-rango-en-ves-de-la-hoja?selectedanswerid=6g395i5pqbj6ipxt
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
        Set h1 = Sheets(1)
'Nombre para el archivo Para solo las iniciales en E8
        nbr = Ini(Quitar(h1.Range("E8"))) & "_" & h1.Name & " " & h1.Range("J8") & " " & h1.Range("K9").Value
'Ruta carpeta destino en la ventana Guardar como:. Puede cambiar la ruta aqui
    rut = "D:\Datos Mecanicos\"
'Guardar copia en
    With Application.FileDialog(msoFileDialogFolderPicker) 'Abre el cuadro dialogo
        .Title = "Selecciona una carpeta"
        .AllowMultiSelect = False
        .InitialFileName = rut
'Si cancela sale de la macro
        If .Show <> -1 Then Exit Sub
        cp = .SelectedItems(1)
    End With
'Copia la hoja
    h1.Copy
'Elimina objetos Shapes (formas) existentes en la hoja
    Set h2 = Sheets(1)
        h2.Shapes.Range(Array("uno", "dos", "tres", "11")).Delete
    'Selection.Delete
'Por si hay datos en este rango y no los quiere en la copia, los eliminará pero tendras Desproteger este rango en la hoja Copia
    h2.Unprotect Password:="By Jot@" 'Desprotege la copia para ejecutar limpiesa en el rango
    h2.Range("L1:Z500").Clear 'puede cambiar el rango o desactivarlo si no lo necesita
'Proteger la copia completa totalmente
    h2.Protect Password:="By Jot@", DrawingObjects:=True, Contents:=True, Scenarios:=True
    h2.EnableSelection = xlNoSelection 'Restringe todo, seleccion y escritura
    ActiveWorkbook.Protect Password:="By Jot@", Structure:=True, Windows:=True
'Guarda hoja como xlsx
    ActiveWorkbook.SaveAs Filename:=cp & "\" & nbr & ".xlsx", _
        FileFormat:=xlOpenXMLWorkbook, ReadOnlyRecommended:=False, _
        CreateBackup:=False
    ActiveWorkbook.Close
    MsgBox "Archivo guardado en " & cp & "\" & nbr & ".xlsx"
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Range("B11").Select
End Sub

SIN QUE abra el cuadro dialogo, guarde directo como XLSX

1º Tengo la carpeta C:\0 ya criada. Que en esa carpeta 0(cero), me crie una sub con nombre del valor de E8 (Range(“8”).value

2º Dentro de esa sub, guarde el libro con el nombre nbr =

La línea para nombre de archivo yo lo haría, sin problema, pero ya la 1º no doy pie con bola aunque trate con esta tu macro

Quedaría algo así: nbr = Sheets.Name & "_" h1.Range(“J8”).value & " " & h1.Range("K9").Value

Estuve con esta tu macro tratando de adaptar, hice algo pero no todo lo que menciono aquí

Sub crearDir() 'Criar directorio en la carpeta del archivo
'Por.Dante Amor
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    ruta = "C:\0" & "\" 'ThisWorkbook.Path & "\"
    carp = Range("E8").Value 'o tambien
    nbr = Range("E9").Value
    'carp = Format([C4], "dd-mm-yy") '"dd-mmm-yyyy
    If Dir(ruta & carp, vbDirectory) = "" Then
        MkDir ruta & carp
'Guarda hoja como xlsx
    ActiveWorkbook.SaveAs Filename:=ruta & carp & "\" & nbr & ".xlsx", _
        FileFormat:=xlOpenXMLWorkbook, ReadOnlyRecommended:=False, _
        CreateBackup:=False
    ActiveWorkbook.Close    
    End If
    MsgBox "Archivo guardado en: " & ruta & carp & "\" & nbr & ".xlsx"
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

Esta la veo sencillisima pero, no se hacerle lo que quiero