Generar archivo sin seleccionar hoja

Donde el mismo genera un archivo con formato excel, el mismo se guarda y luego se adjunta a un correo.

Mi consulta es si se podrá evitar seleccionar la hoja y que genere el archivo, intente con mencionar la hoja, pero al generar archivo lo hace en blanco

Paso código que uso.

Dim nombrearchivo As String
Worksheets("HOJA1").Visible = True
Worksheets("HOJA1").Select
mio = ActiveWorkbook.Name
nombrearchivo = Sheets("HOJA1").Range("C9") & " " & ("Flete N° ") & " " & Sheets("HOJA1").Range("C11") & Sheets("HOJA1").Range("C1").Value 'Nombre para el archivo
Ruta = "C:\"
Workbooks.Add
otro = ActiveWorkbook.Name
Workbooks(mio).Activate
Range("B9:H47").Copy
Workbooks(otro).Activate
Sheets(1).Select
Range("a1").Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
ActiveWorkbook.SaveAs Ruta & nombrearchivo
ActiveWorkbook.Close False
nombrearchivo = "C:\" & nombrearchivo & ".xlsx"
Sheets("HOJA1").Visible = False

1 respuesta

Respuesta
1

Pero al generar archivo lo hace en blanco

Lo genera en blanco porque no estás pegando los valores, solamente estás pegando el ancho de columnas:

Selection.PasteSpecial Paste:=xlPasteColumnWidths


Te anexo el código para copiar y pegar los valores. No es necesario hacer visible o seleccionar la "HOJA1".

También te pongo el código para enviar el correo:

Sub GenerarArchivo()
  Dim sNombre As String, sRuta As String
  Dim sh As Worksheet, wb As Workbook, dam As Object
  '
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  '
  'DATOS INICIALES
  Set sh = Sheets("HOJA1")
  sRuta = "C:\trabajo\"
  sNombre = sh.Range("C9") & " " & ("Flete N° ") & " " & sh.Range("C11") & sh.Range("C1").Value
  '
  'GUARDAR ARCHIVO
  Set wb = Workbooks.Add
  sh.Range("B9:H47").Copy
  wb.Sheets(1).Range("A1").PasteSpecial Paste:=xlPasteValues
  wb.Sheets(1).Range("A1").PasteSpecial Paste:=xlPasteColumnWidths
  wb.SaveAs sRuta & sNombre & ".xlsx"
  wb.Close False
  '
  'ENVIAR CORREO
  Set dam = CreateObject("outlook.application").createitem(0)
  dam.To = "[email protected]"
  dam.Subject = "Asunto"
  dam.body = "Cuerpo del mensaje"
  dam.Attachments.Add sRuta & sNombre & ".xlsx"
  'dam.send 'El correo se envía en automático
  dam.display 'El correo se muestra
  '
  Application.CutCopyMode = False
  Application.ScreenUpdating = False
End Sub

Nota: si alguna de las celdas, para nombrar el archivo, tiene fecha, deberás cambiar el formato de la fecha, en el nombre del archivo, para que no contenga la diagonal "/", ya que no se puede utilizar en el nombre de un archivo.

Hola dante, antes que nada gracias por responder tan rápido.

El código me arroja un error (438), me genera el archivo pero solo con valores.

Te paso código original dónde también esta incluido para la impresión, el único drama en este código es que no funciona si la hoja no esta seleccionada.

Worksheets("hoja1").Visible = True
Worksheets("hoja1").Select
mio = ActiveWorkbook.Name
nombrearchivo = Range("C9") & " " & ("Flete N° ") & " " & Range("C11") & Range("C1").Value 'Nombre para el archivo
Ruta = "C:\trabajo\"
Workbooks.Add
otro = ActiveWorkbook.Name
Workbooks(mio).Activate
Range("B9:H47").Copy
Workbooks(otro).Activate
Sheets(1).Select
Range("a1").Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = "$B$9:$H$47"
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.7)
        .RightMargin = Application.InchesToPoints(0.7)
        .TopMargin = Application.InchesToPoints(0.75)
        .BottomMargin = Application.InchesToPoints(0.75)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 66
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True
ActiveWorkbook.SaveAs Ruta & nombrearchivo
ActiveWorkbook.Close False
nombrearchivo = "C:\trabajo\" & nombrearchivo & ".xlsx"
Worksheets("hoja1").Visible = False

Revisemos mi código.

El código me arroja un error (438), me genera el archivo pero solo con valores.

En cuál línea se detiene.

¿La idea son solamente los valores o también quieres los formatos o quieres todo?

Si quieres todo, entonces prueba esto:

Sub GenerarArchivo()
  Dim sNombre As String, sRuta As String
  Dim sh As Worksheet, wb As Workbook, dam As Object
  '
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  '
  'DATOS INICIALES
  Set sh = Sheets("HOJA1")
  sRuta = "C:\trabajo\"
  sNombre = sh.Range("C9") & " " & ("Flete N° ") & " " & sh.Range("C11") & sh.Range("C1").Value
  '
  'GUARDAR ARCHIVO
  Set wb = Workbooks.Add
  sh.Range("B9:H47").Copy
  wb.Sheets(1).Range("A1").PasteSpecial Paste:=xlPasteValues
  wb.Sheets(1).Range("A1").PasteSpecial Paste:=xlPasteAll
  wb.SaveAs sRuta & sNombre & ".xlsx"
  wb.Close False
  '
  Application.CutCopyMode = False
  Application.ScreenUpdating = False
End Sub

Con eso ya tienes el archivo.

No entiendo tu demás código.

Prueba primero la generación del archivo y después vemos tu otro código.

Faltó el ancho de columnas.

Sub GenerarArchivo()
  Dim sNombre As String, sRuta As String
  Dim sh As Worksheet, wb As Workbook, dam As Object
  '
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  '
  'DATOS INICIALES
  Set sh = Sheets("HOJA1")
  sRuta = "C:\trabajo\"
  sNombre = sh.Range("C9") & " " & ("Flete N° ") & " " & sh.Range("C11") & sh.Range("C1").Value
  '
  'GUARDAR ARCHIVO
  Set wb = Workbooks.Add
  sh.Range("B9:H47").Copy
  wb.Sheets(1).Range("A1").PasteSpecial Paste:=xlPasteAll
  wb.Sheets(1).Range("A1").PasteSpecial Paste:=xlPasteColumnWidths
  wb.SaveAs sRuta & sNombre & ".xlsx"
  wb.Close False
  '
  Application.CutCopyMode = False
  Application.ScreenUpdating = False
End Sub

Como mencioné anteriormente, prueba la generación del archivo y después vemos lo demás que necesitas.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas