Excel 2007 crear una carpeta con el nombre la fecha actual y y guarde la hoja activa con el nombre de celdas G7+F4
"para Dante Amor"
Preciso una macro que me cree una carpeta con el nombre de "pedidos + la fecha y hh : mm : ss actual y la guarde en "C: \ Documents and Settings \ Administrador \ Escritorio \ PEDIDOS LAMA" y dentro de esa carpeta que se guarda la hoja activa con el nombre de dos celdas ""g7+f4"( que seria el nombre del cliente + la fecha). La extencion que se guarde el archivo seria .xls, para que sea compatible con versiones anteriores.
Con respecto la la creación de la nueva carpeta "pedidos + fecha actual" ; que cada vez que se guarde una hoja activa creada el mismo día que se guarden todas en la misma carpeta . Osea
Así me quedarían todos los pedidos hechos en esa fecha dentro de la misma carpeta.
Espero haber explicado bien porque no entiendo mucho de macros
1 Respuesta
H o l a:
La macro crea la carpeta si no existe, pero si ya existe, en la misma carpeta va guardando los archivos.
Otro detalle, la macro funciona para que se ejecute desde la versión 2007 o mayor. Si la macro la vas a ejecutar con un excel versión 2003, hay que probarla, si no te funciona me comentas para preparar la macro para que funcione en versión 2003.
Sub GuardaHojaXls() 'Por.Dante Amor Application.ScreenUpdating = False Application.DisplayAlerts = False Set l1 = ThisWorkbook Set h1 = l1.ActiveSheet ruta = "C:\Documents and Settings\Administrador\Escritorio\PEDIDOS LAMA\" 'ruta = "C:\trabajo\" carp = "pedidos " & Format(Date, "dd-mm-yyyy") nomb = h1.[G7] & " " & Format(h1.[F4], "dd-mm-yyyy") ' rut2 = ruta & carp If Dir(rut2, vbDirectory) = "" Then MkDir rut2 End If ' h1.Copy Set l2 = ActiveWorkbook l2.SaveAs Filename:=rut2 & "\" & nomb & ".xls", _ FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _ ReadOnlyRecommended:=False, CreateBackup:=False 'l2.SaveAs rut2 & "\" & nomb & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False l2.Close MsgBox "Hoja Guardarda", vbInformation, "CREAR CARPETA Y GUARDAR HOJA" End Sub
':) ':)
