Excel Visual Basic modificar macro para copiar archivos en otra ruta y no en la actual
Adjunto un enlace a un excel, donde creo una carpeta en un directorio aparte. La carpeta ya la he creado y todo ok, (te lo explico en verde en el código), además hago dentro de ella una copia del fichero actual.
El problema es que luego creo 3 archivos más que hasta ahora se estaban guardando en la ruta actual y no sé cómo indicarle que me lo guarde en la nueva carpeta que he creado. ¿Podrías echarle un vistazo?
Mil gracias! shorturl.at/jrsNZ
Hola, Dante.
Te estoy intentando pegar el código pero me da error... dice que lo intente más tarde. Lo sigo intentando...
Hola, Dante.
Comienzo la macro creando una nueva carpeta en otro directorio, ahí también guardo una copia del fichero actual (hasta ahí todo bien, he sido capaz de hacerlo ;)).
Pero después creo tres archivos más, que hasta ahora estaba guardando en la ruta actual, no sé cómo hacer el cambio y decirle que me lo guarde en ese nuevo directorio...
Sub CREA_CARPETA_EXPORTA()
'creamos en otro directorio una nueva carpeta con la fecha y hora actual y hacemos una copia del libro actual dentro
Dim sruta As String
Dim nombrecarpeta As String
Dim sseparadorruta As String
Dim snombrelibroactual As String
snombrelibroactual = Application.ActiveWorkbook.Name
sseparadorruta = Application.PathSeparator
sruta = "C:\Users\Ana\Documents" 'directorio donde queremos crear la nueva carpeta
nombrecarpeta = CStr(Format(Date, "dd-mm-yyyy")) _
& "-" & CStr(Format(Time, "hh-mm-ss"))
If Dir(sruta & sseparadorruta & nombrecarpeta, vbDirectory) = Empty Then
MkDir (sruta & sseparadorruta & nombrecarpeta)
End If
Application.ActiveWorkbook.SaveCopyAs Filename:=sruta _
& sseparadorruta & nombrecarpeta & sseparadorruta & snombrelibroactual
Application.StatusBar = "Una copia de este libro se guardó en:" & sruta _
& sseparadorruta & nombrecarpeta & sseparadorruta & snombrelibroactual
(PARTE UNO)
No me deja pegar el resto... me sale error todo el tiempo.
parte dos, ahora se guardan en la ruta actual, cómo le digo que me lo guarde en el directorio que he creado con fecha y hora actual?:
Sub ExportarHojaTxt()
'Por.Dante Amor
Dim hojas As Variant, sh As Variant
hojas = Array("Hoja1", "Hoja2")
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim lr As Long
For Each sh In hojas
With Sheets(sh)
lr = .Range("B:AB").Find("*", , xlValues, , xlByRows, xlPrevious).Row
.Range("B7:AB" & lr).Copy
Workbooks.Add
Range("A1").PasteSpecial xlPasteValues
Range("E:E").NumberFormat = "mm/dd/yyyy"
Cells.EntireColumn.AutoFit
End With
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & "Prueba " & sh & ".txt", FileFormat:=xlText, Local:=True
ActiveWorkbook.Close False
Next
End Sub
parte tres: exportar una de las hojas de ese excel (por ejemplo hoja3) como un nuevo libro en el directorio que he creado, hasta ahora también tengo que se guarde en la ruta actual..
perdona la división en tres partes, pero no me deja copiarlo entero...
Existen algunas palabras reservadas que el editor de este foro no permite.
Es por eso que no puedes pegar el código.
Puedes poner el código (también en partes) pero en imágenes, para tratar de identificar cuál es la palabra reservada.
En la parte uno del código, qué tienes después de estas líneas:
Application.StatusBar = "Una copia de este libro se guardó en:" & sruta _ & sseparadorruta & nombrecarpeta & sseparadorruta & snombrelibroactual
Junté la parte 1 y la parte 2 en una sola macro.
Simplifiqué algunas líneas de las 2 macros, también algunos nombres. En lo personal, me gusta trabajar con variables con nombres cortos.
Prueba lo siguiente:
Sub ExportarHojaTxt()
'Por.Dante Amor
Dim hojas As Variant, sh As Variant, lr As Long
Dim sRuta As String, sCarpeta As String, sLibro As String
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'
sLibro = Application.ActiveWorkbook.Name
sRuta = "C:\Users\Ana\Documents\" 'directorio donde queremos crear la nueva carpeta
sCarpeta = CStr(Format(Date, "dd-mm-yyyy")) & "-" & CStr(Format(Time, "hh-mm-ss"))
'creamos en otro directorio una nueva carpeta con la fecha y hora actual y hacemos una copia del libro actual dentro
If Dir(sRuta & sCarpeta, vbDirectory) = Empty Then
MkDir sRuta & sCarpeta
End If
ActiveWorkbook.SaveCopyAs sRuta & sCarpeta & "\" & sLibro
'
hojas = Array("Hoja1", "Hoja2")
For Each sh In hojas
With Sheets(sh)
lr = .Range("B:AB").Find("*", , xlValues, , xlByRows, xlPrevious).Row
.Range("B7:AB" & lr).Copy
Workbooks.Add
Range("A1").PasteSpecial xlPasteValues
Range("E:E").NumberFormat = "mm/dd/yyyy"
Cells.EntireColumn.AutoFit
End With
ActiveWorkbook.SaveAs Filename:=sRuta & sCarpeta & "\" & "Prueba " & sh & ".txt", FileFormat:=xlText, Local:=True
ActiveWorkbook.Close False
Next
End Sub
¡Muchas gracias! Entendí (o eso creo) muy bien la parte de pegar en la nueva carpeta. Hice lo mismo con la Hoja3, exportarla a un libro dentro de esa carpeta. No sale ningún error, pero no se copia... no aparece en ningún lado. No sé porqué
Dim nombredos as string, archivodos as string
ACtiveworkbook.sheets("Hoja3").Copy
Nombredos = Left(Thisworkbook.Name, InStrRev(Thisworkbook.Name, ".")) & "xlsx"
Archivodos =Thisworkbook.Path & "\" & Fromat (Now, "yyyymmdd, hhmmss") & nombredos
Activeworkbook.savecopyas sruta & scarpeta & "\" slibro
Activeworkbook.close
Lo he buscado por todas partes pero no sé si en realidad se llega a exportar, error no me sale. Grcias!
