Corrección de macro para crear y copiar hoja a determinada carpeta

[JoaoM]

Hola amigos
Tengo esta macro la cual crea carpeta y sub carpeta pero:

Código:

Sub CreaCarpetas()

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    MkDir "C:\trabajo" ' SI YA EXISTE LA CARPETA, MANDA ERROR
    
    ruta = "C:\trabajo\"
    año = Format(Date, "YYYY")
    mes = Format(Date, "mmmm-YYYY")
    On Error Resume Next
    MkDir ruta & "\" & año
    MkDir ruta & "\" & año & "\" & mes
    On Error GoTo 0
    '
    ruta = ruta & año & "\" & mes & "\"
    
    arch = "Parte.xlsx" 'Aqui el auto-nombre de hoja HOJA.NAME\.XLSX
    Sheets("Parte").Copy 'AQUI EL AUTONOMBRE DE HOJA HOJA.NAME
    
    ActiveWorkbook.SaveAs Filename:=ruta & arch, FileFormat:=xlOpenXMLWorkbook
    ActiveWorkbook.Close

    Application.ScreenUpdating = True
        Application.DisplayAlerts = True
        
    MsgBox "Hoja copiada"
End Sub

1º Si la carpeta C:\trabajo ya existe, manda error en esa linea

2º Quiero que para copiar la hoja, no tenga el nombre especifico de la hoja si no que busque nombre de hoja, Sheets.name, (WorkSheet.name (creo)) es decir, si la hoja no es la misma a copiar, tendria que a cada momento cambiar su nombre en la macro

3º Que la ruta sea una sola, es decir, que ruta haga referencia a

Código:

ruta = "C:\trabajo" & format(Date, "yyyy") & format(Date, "mmmm-yyyy")

las 3 en una sola linea. Trate de hacerlo pero siempre manda error

Gracias