Copiar una hoja en una carpeta creada automáticamente
Estoy haciendo una macro que me copie una hoja llamada código en una carpeta en el directorio donde se encuentra el libro, esta carpeta debe crearse automáticamente sino existe, y debe guardarse por mes, ejemplo si estamos en el año 2015 en el mes de marzo al darle clic a mi botón la hoja código deberá guardarse en la carpeta año-2015 y dentro de esta carpeta estar una carpeta que se llame 03-mar y dentro de esa carpeta mi hoja código como un nuevo documento de excel sin macro alguna.
Cada vez que se le da click al botón debe ver que año es para guardar en la carpeta del año correspondiente y dentro de ese año el mes correspondiente, y si las carpetas no existen, crearlas. Espero haberme explicado bien, cualquier ayuda y colaboración sera bienvenida.
1 Respuesta
Te anexo la macro, el nuevo libro se va a llamar "codigo.xlsx"
Sub CrearHoja()
'Por.Dante Amor
Application.ScreenUpdating = False
Application.DisplayAlerts = False
ruta = ThisWorkbook.Path & "\"
año = Year(Date)
mesn = Format(Month(Date), "00")
mesl = Format(Date, "mmm")
mesx = mesn & "-" & mesl
carpeta1 = ruta & "año-" & año
'
If Dir(carpeta1, vbDirectory) = "" Then
MkDir (carpeta1)
End If
'
carpeta2 = carpeta1 & "\" & mesx
If Dir(carpeta2, vbDirectory) = "" Then
MkDir (carpeta2)
End If
'
Sheets("código").Copy
ActiveWorkbook.SaveAs carpeta2 & "\codigo.xls"
ActiveWorkbook.Close
'
MsgBox "Hoja Creada"
End SubSaludos.Dante Amor
Un detalle, te anexo la nueva macro, porque me faltó una x en la extensión del nuevo archivo:
Sub CrearHoja()
'Por.Dante Amor
Application.ScreenUpdating = False
Application.DisplayAlerts = False
ruta = ThisWorkbook.Path & "\"
año = Year(Date)
mesn = Format(Month(Date), "00")
mesl = Format(Date, "mmm")
mesx = mesn & "-" & mesl
carpeta1 = ruta & "año-" & año
'
If Dir(carpeta1, vbDirectory) = "" Then
MkDir (carpeta1)
End If
'
carpeta2 = carpeta1 & "\" & mesx
If Dir(carpeta2, vbDirectory) = "" Then
MkDir (carpeta2)
End If
'
Sheets("código").Copy
ActiveWorkbook.SaveAs carpeta2 & "\codigo.xlsx"
ActiveWorkbook.Close
'
MsgBox "Hoja Creada"
End SubSaludos.Dante Amor
