Macro para guardar e imprimir hoja de un libro excel

Siendo sábado, me di tiempo de hacer esto:

Sub Guardando()
Dim Nombredelescritorio As String, Formatodia As String, Formatohora As String
Application.ScreenUpdating = False
Sheets("Hoja1").PrintOut Copies:=1, Collate:=True
Let Nombredelescritorio = CreateObject("wscript.shell").specialfolders("desktop")
Let Formatodia = Format(Date, "dd-mm-yyyy")
Let Formatohora = Format(Time, "hhmmss")
Sheets("Hoja1").Copy
ActiveWorkbook.SaveAs Nombredelescritorio & "\" & ActiveSheet.Name & Formatodia & Formatohora
ActiveWorkbook.Close
Application.ScreenUpdating = True
End Sub

Comentas

Abraham Valencia

¿Muchas Gracias Abraham Valencia en que parte de este código debería poner la dirección real de la carpeta en donde guardar el archivo?

Te anexo la macro para guardar la hoja en el libro "remito.xlsx"

El libro "remito.xlsx" deberá estar en tu carpeta de escritorio

Si no existe tu escritorio la macro te envía un error

Si el archivo "remito.xlsx" no existe en el escritorio te envía un error

Cambia en la macro en esta línea "Hoja1" por el nombre de la hoja que quieras guardar en el archivo "remito.xlsx"

Set h1 = l1.Sheets("Hoja1")

Cambia en esta línea el nombre del libro  "remito.xlsx"

destino = "remito.xlsx"

No que no me quedó claro es si quieres guardar el nuevo libro en el escritorio o donde tienes el archivo con la macro. La macro va con el escritorio. Si quieres que se guarde en la misma carpeta donde tienes la macro cambia esta línea:

l2.SaveAs Filename:=escritorio & "\" & nombre, FileFormat:=xlOpenXMLWorkbook

Por esta:

l2.SaveAs Filename:=ruta & "\" & nombre, FileFormat:=xlOpenXMLWorkbook

.

Sub Copiar_Hoja()
'Por. Dante Amor
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets("Hoja1")
    ruta = l1.Path & "\"
    '
    'obtener la ruta del escritorio
    On Error Resume Next
    escritorio = CreateObject("WScript.Shell").SpecialFolders("Desktop")
    If Err.Number <> 0 Then
        MsgBox "No se encuentra la carpeta del escritorio. "
        Exit Sub
    End If
    '
    'abrir libro remito
    destino = "remito.xlsx"
    If Dir(escritorio & "\" & destino) = "" Then
        MsgBox "No existe el libro " & destino
        Exit Sub
    End If
    Set l2 = Workbooks.Open(destino)
    '
    nombre = "remito " & Format(Now, "dd-mm-yyyy hh-mm")
    h1.PrintOut
    h1.Copy after:=l2.Sheets(l2.Sheets.Count)
    l2.SaveAs Filename:=escritorio & "\" & nombre, FileFormat:=xlOpenXMLWorkbook
    l2.Close False
    MsgBox "Hoja impresa y guardada en libro " & nombre, vbInformation
End Sub

No entendí lo de varias hojas, tendría que hacer un ciclo por cada hoja o copiar de una vez todas o tú decidirás en qué momento copiar una hoja.

.

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

.

Avísame cualquier duda

.

Hola Dante mil gracias! Mira la dirección de destino seria esta pero no me lo toma no se porque

C:\Users\Tu Hermana en Tanga\Desktop\remitos\remitos_queruclor

Y por otro lado debería imprimir cada vez que imprime 3 copias de la hoja

Te super agradezco por la mano que me estas dando

Esos son 2 datos que no habías mencionado

Te anexo la macro actualizada para abrir el libro remito en la ruta que pusiste e imprimir 3 copias

Sub Copiar_Hoja()
'Por. Dante Amor
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets("Hoja1")
    ruta = l1.Path & "\"
    '
    'obtener la ruta del escritorio
'    On Error Resume Next
'    escritorio = CreateObject("WScript.Shell").SpecialFolders("Desktop")
'    If Err.Number <> 0 Then
'        MsgBox "No se encuentra la carpeta del escritorio. "
'        Exit Sub
'    End If
    escritorio = "C:\Users\Tu Hermana en Tanga\Desktop\remitos\remitos_queruclor\"
    '
    'abrir libro remito
    destino = "remito.xlsx"
    If Dir(escritorio & "\" & destino) = "" Then
        MsgBox "No existe el libro " & destino
        Exit Sub
    End If
    Set l2 = Workbooks.Open(destino)
    '
    nombre = "remito " & Format(Now, "dd-mm-yyyy hh-mm")
    h1.PrintOut Copies:=3
    h1.Copy after:=l2.Sheets(l2.Sheets.Count)
    l2.SaveAs Filename:=escritorio & "\" & nombre, FileFormat:=xlOpenXMLWorkbook
    l2.Close False
    MsgBox "Hoja impresa y guardada en libro " & nombre, vbInformation
End Sub

.

'S aludos. Dante Amor. Recuerda valorar la respuesta.

.

sabes que me sale el siguiente mensaje: