Excel Visual Basic modificar macro para copiar archivos en otra ruta y no en la actual

Antes de descargar tu archivo, podrías explicar aquí lo que necesitas.

¿Quieres un cambio en tu macro? Pon aquí tu macro.

O si me explicas paso a paso lo que deseas, genero una nueva macro.

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