Modificar Macro para guardar en otro directorio

Tengo una macro que me guarda la hoja "historico" en el mismo directorio donde tengo el libro activo es la siguiente:

Sub RealizaCopiaHistorico()
PathActual = ActiveWorkbook.Path
NombreLibro = PathActual + "\" + ActiveWorkbook.Name
NombreCopia = Mid(NombreLibro, 1, Len(NombreLibro) - 4) + " HISTORICO Mes " + Format(Date, "MM-YYYY") + ".xlsx"
ActiveWorkbook.ActiveSheet.Copy
ActiveWorkbook.SaveCopyAs Filename:=NombreCopia
MsgBox ("Copia Historico Realizada")
ActiveWorkbook.Close False
End Sub

¿Se podría modificar para que me la guardase en otra carpeta diferente?
¿Esta carpeta podría llevar el nombre del contenido de la celda J1?

Respuesta
1

Hazlo así:

Sub RealizaCopiaHistorico()If [j1] <> "" Then        PathActual = [j1]    Else        PathActual = ActiveWorkbook.PathEnd IfNombreLibro = PathActual + "\" + ActiveWorkbook.NameNombreCopia = Mid(NombreLibro, 1, Len(NombreLibro) - 4) + " HISTORICO Mes " + Format(Date, "MM-YYYY") + ".xlsx"ActiveWorkbook.ActiveSheet.CopyActiveWorkbook.SaveCopyAs Filename:=NombreCopiaMsgBox ("Copia Historico Realizada")ActiveWorkbook.Close FalseEnd Sub

Si te ha valido la respuesta. 

Sub RealizaCopiaHistorico()
If [j1] <> "" Then
        PathActual = [j1]
    Else
        PathActual = ActiveWorkbook.Path
End If
NombreLibro = PathActual + "\" + ActiveWorkbook.Name
NombreCopia = Mid(NombreLibro, 1, Len(NombreLibro) - 4) + " HISTORICO Mes " + Format(Date, "MM-YYYY") + ".xlsx"
ActiveWorkbook.ActiveSheet.Copy
ActiveWorkbook.SaveCopyAs Filename:=NombreCopia
MsgBox ("Copia Historico Realizada")
ActiveWorkbook.Close False
End Sub

Si no hay nada en la celda J1, pone el path actual, si no, lo que hay en la celda.

En la celda el nombre de carpeta debe comenzar por la letra de la unidad donde quieres grabar seguido de :\, así-> "C:\"

1 respuesta más de otro experto

Respuesta
1

Te anexo la macro para verificar si existe la carpeta que pusiste en la celda J1.

Si no existe la carpeta, te muestra un mensaje para que decidas guardar en la misma carpeta o cancelar para corregir el nombre de la carpeta que está en la celda.

Sub RealizaCopiaHistorico()
'Act.Por.Dante Amor
    celda = "J1"
    If ActiveSheet.Range(celda) = "" Then
        PathActual = ActiveWorkbook.Path
    Else
        If Dir(ActiveSheet.Range(celda)) = "" Then
            If MsgBox("La carpeta de la celda " & celda & ", no existe" & vbCr & vbCr & _
               "Deseas guardar en el mismo directorio", vbQuestion + vbYesNo, "REVISAR") = vbNo Then
                Exit Sub
            Else
                PathActual = ActiveWorkbook.Path
            End If
        Else
            PathActual = ActiveSheet.Range(celda)
        End If
    End If
    '
    NombreLibro = PathActual + "\" + ActiveWorkbook.Name
    NombreCopia = Mid(NombreLibro, 1, Len(NombreLibro) - 4) + " HISTORICO Mes " + Format(Date, "MM-YYYY") + ".xlsx"
    ActiveWorkbook.ActiveSheet.Copy
    ActiveWorkbook.SaveCopyAs Filename:=NombreCopia
    MsgBox ("Copia Historico Realizada")
    ActiveWorkbook.Close False
End Sub

Saludos.Dante Amor

No reconoce la carpeta existente cuyo nombre es el contenido de la celda j1 (es la fecha) siempre sale el cuadro de dialogo exista o no la carpeta,¿si no estuviera se podría hacer que la creara?

Te anexo la macro con las actualizaciones, supongo que quieres crear la carpeta debajo de donde tienes el archivo con la macro.

Nota: El nombre de las carpetas no pueden tener el carácter "/", no importa que la celda "J1" tengas la fecha 04/02/2015, la macro buscará la carpeta 04-02-2015, si la encuentra, en esa carpeta guardará el archivo.

Si no encuentra la carpeta, creará la carpeta 04-02-2015 y dentro de esta carpeta el archivo.

Sub RealizaCopiaHistorico()
'Act.Por.Dante Amor
    celda = "J1"
    PathActual = ActiveWorkbook.Path
    If ActiveSheet.Range(celda) = "" Then
        PathActual = ActiveWorkbook.Path
    Else
        ruta = PathActual & "\" & Format(Range(celda), "dd-mm-yyyy")
        If Dir(ruta, vbDirectory) = "" Then
            If MsgBox("La carpeta no existe, deseas crearla" & vbCr & vbCr & _
               "Deseas guardar en el mismo directorio", vbQuestion + vbYesNo, "REVISAR") = vbNo Then
                Exit Sub
            Else
                MkDir ruta
                PathActual = ruta
            End If
        Else
            PathActual = ruta
        End If
    End If
    '
    NombreLibro = PathActual + "\" + ActiveWorkbook.Name
    NombreCopia = Mid(NombreLibro, 1, Len(NombreLibro) - 4) + " HISTORICO Mes " + Format(Date, "MM-YYYY") + ".xlsx"
    ActiveWorkbook.ActiveSheet.Copy
    ActiveWorkbook.SaveCopyAs Filename:=NombreCopia
    MsgBox ("Copia Historico Realizada")
    ActiveWorkbook.Close False
End Sub

Saludos.Dante Amor

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas

Crear backup de un archivo de excel

Agradezco la colaboración que me puedas brindar con esto, quiero crear un macro que me haga un backup de un archivo de excel que se llama información, que realice la copia todos los días a las 5:30 pm y que se cree la copia de este archivo en c en...
1 respuesta

Macro que abra todos los archivos de excele de una carpeta

E tratado de crear una macro en la cual yo le de la dirección path de carpeta y me abra todos los archivos de excel contenidos en dicha carpeta, pero los métodos que e encontrado solamente me dan la opción de abrir uno ya que debo poner la dirección...
1 respuesta

Ayuda con código vba para Copiar y Guardar Hojas

Tengo este código para seleccionar directorio para guardar 2 hojas a copiar: Dim Titulo, Directorio As String Sub SeleccionarDirectorio() Titulo = "Selecciona la ruta de tu carpeta" On Error Resume Next 'evitaría un error en caso de no seleccionar...
1 respuesta

¿Crear carpeta según valor de celda y guardar una copia de mi libro en esa carpeta creada?

Quisiera saber si puedo generar una carpeta con valor de la celda a2 hasta f50 pero que se crea la carpeta con valor de la celda a2 y mi libro me lo guarde en esa carpeta.
2 respuestas

Seleccionar Varias hojas y copiar o mover a un nuevo libro

Necesito un código que seleccione varias hojas de un libro para mover o copiar a un libro nuevo la hojas seleccionadas, solo necesito seleccionar la varias hojas que están no estén vacías en la celda a1 de cada hoja, tengo este código pero no logro...
1 respuesta

Guardar vía macro con nombre=hora del sistema

Necesito de vuestra inestimable ayuda. Tengo un fichero el cual, a la hora de documentarse una serie de celda, pretendo que, via macro, se haga: - Guardar el fichero con un nombre y dentro de este nombre, se forme con la hora del sistema (hhmmss). -...
1 respuesta

Macro formato de fecha

Quería ver si me pueden ayudar en lo siguiente, tengo la fecha en las columnas "F:F" y "G:G" y están de la siguiente forma 21/03/12. Estas fechas las extraigo de un archivo txt algunas me las muestra con formato completo es decir 21/03/2012 y otras...
1 respuesta

Mostrar MsgBox Si el Archivo ya existe en una Carpeta especifica al Guardar

'Espero su ayuda Solo Necesito el MsgBox Indicando Que el archivo ya existe... Gracias Private Sub CommandButton1_Click() If TextBox1 = "" Then MsgBox " NO INGRESASTES MES ", vbExclamation, "YACHAY MAQUI" TextBox1.SetFocus Else...
1 respuesta

Unir un conjunto de excels/csv a uno sólo

En una carpeta tengo varios excel en formato csv que recogen los siguientes datos: CRC-value,"FileDate","PATH","FILENAME","PAGES","KEYSTROKES IN FILENAME","FILE SIZE". Mi consulta es si se podría crear una macro en un excel nuevo que me recogiera...
1 respuesta

Obtener el nombre de un archivo de acuerdo a una ruta ya obtenida en variable

Mi pregunta es la como puedo obtener el nombre de un aechivo que acabo de abrir con un opendialog. Lo que quiero hacer es copiar distintos rangos de celdas de un archivo a otro por medio de una macro este es el código: Sub copiar() Dim Filename As...
2 respuestas