Problema código para guardar archivo nuevo

Tengo un tema... Tengo toda una macro que hace lo siguiente:

- Se abre desde el archivo base (llamado 2017 V6 - Plan Operativo.xlsm)

- Abre un archivo existente (llamado GENERADOR.xlsx)

- Vuelve al archivo base

- Copia tablas

- Las pega en Generador

- Guarda el archivo generador con un nombre nuevo...

En este ultimo punto es donde comienza el problema. Al guardar el nuevo archivo, con nombre y ruta especificada por variables de la misma hoja del excel, en vez de guardarme el archivo GENERADOR me guarda el base, lo cual esta mal :(

Además de ello, el archivo GENERADOR no me lo cierra, y si le pongo el comando, me da error, si se lo saco, me da error en la línea siguiente.

Adjunto el código para que lo vean:

Private Sub CommandButton3_Click()
'Mensaje de confirmacion de accion
Dim Resp As Byte
Resp = MsgBox("¿Desea generar el informe?. Tenga en consideración que se guardá un archivo adicional, el cual deberá ser enviado.", _
    vbQuestion + vbYesNo, "ACTUALIZAR")
If Resp = vbYes Then
'Poner visible las hojas ocultas
Sheets("TABLA_PPTO").Visible = True
Sheets("TABLA_DOTACION").Visible = True
Sheets("TABLA_DOTACION2").Visible = True
Sheets("TABLA_ENCUESTAS").Visible = True
'Abrir archivo de almacenamiento y cambio a hoja de llenado
    Ruta = ThisWorkbook.Path
    Abrir = "GENERADOS\GENERADOR.xlsx"
    Workbooks.Open Filename:=Ruta & "\" & Abrir
    Windows("2017 V6 - Plan Operativo.xlsm").Activate
'Seleccion y copiado de datos de las distintas tablas
    Sheets("TABLA_PPTO").Select
    ActiveSheet.Range("A2:AR2341").Select
    Selection.Copy
        Windows("GENERADOR.xlsx").Activate
    Sheets("PPTO_DOT").Select
    ActiveSheet.Range("A2").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("2017 V6 - Plan Operativo.xlsm").Activate
    Sheets("TABLA_DOTACION").Select
    ActiveSheet.Range("A2:AR496").Select
    Selection.Copy
        Windows("GENERADOR.xlsx").Activate
    ActiveSheet.Range("A1").End(xlDown).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("2017 V6 - Plan Operativo.xlsm").Activate
    Sheets("TABLA_DOTACION2").Select
    ActiveSheet.Range("A2:AR1441").Select
    Selection.Copy
        Windows("GENERADOR.xlsx").Activate
    ActiveSheet.Range("A1").End(xlDown).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
     Windows("2017 V6 - Plan Operativo.xlsm").Activate
    Sheets("TABLA_ENCUESTAS").Select
    ActiveSheet.Range("A2:AY19").Select
    Selection.Copy
        Windows("GENERADOR.xlsx").Activate
    Sheets("ENCUESTAS").Select
    ActiveSheet.Range("A2").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'Guardado de archivo de envio
    Ruta = Left(ThisWorkbook.Path, InStrRev(ThisWorkbook.Path, "\")) & "\GENERADOS\"
    Nombre = ActiveSheet.Range("D2").Value & "_" & ActiveSheet.Range("N2").Value
    DatoFechador = Format(Now, "yyyymmdd hh.mm.ss")
    Windows("GENERADOR.xlsx").Activate
    FilePath = ThisWorkbook.Path & Nombre & "_" & DatoFechador & ".xls"
    ThisWorkbook.SaveCopyAs (FilePath)
    Windows("2017 V6 - Plan Operativo.xlsm").Activate
    Windows("GENERADOR.xlsx").Activate
'Ocultar hojas base inicial
    Windows("2017 V6 - Plan Operativo.xlsm").Activate
    Sheets("TABLA_ENCUESTAS").Select
    ActiveWindow.SelectedSheets.Visible = False
    Sheets("TABLA_DOTACION2").Select
    ActiveWindow.SelectedSheets.Visible = False
    Sheets("TABLA_DOTACION").Select
    ActiveWindow.SelectedSheets.Visible = False
    Sheets("TABLA_PPTO").Select
    ActiveWindow.SelectedSheets.Visible = False
    ActiveWindow.ScrollWorkbookTabs Sheets:=-1
    ActiveWindow.ScrollWorkbookTabs Sheets:=-1
    ActiveWindow.ScrollWorkbookTabs Sheets:=-1
    Sheets("PRODUCTO").Select
    ActiveSheet.Range("C5").Select
Else
    cancelacion.Show
End If
End Sub

Espero alguien pueda ayudarme ya que necesito esto para hoy en un par de horas más!!!!

(Bueno, la macro después hace otras cosas como ocultar hojas del archivo Base)

3 respuestas

Respuesta
1

ThisWorkbook hace referencia al libro donde esta la macro, no al libro activo, el libro activo es con ActiveWorkbook. Name, supongo que el libro donde tienes la macro es la base por eso te guarda siempre ese libro.

ThisWorkbook. SaveCopyAs (FilePath)
Respuesta
1

H   o la:

Te anexo la macro con varios cambios. En esta forma no es necesario hacer visibles las hojas.

- Primero establecí en el objeto l1 el libro base (Thisworkbook)

- En l2 se estable el libro "generador"

- La ruta para abrir el libro y guardar es la misma

- Al final cierro el libro l2

Private Sub CommandButton3_Click()
'Por.Dante Amor
    Application.ScreenUpdating = False
    'Mensaje de confirmacion de accion
    Resp = MsgBox("¿Desea generar el informe?. Tenga en consideración que se guardá un archivo adicional, el cual deberá ser enviado.", _
    vbQuestion + vbYesNo, "ACTUALIZAR")
    If Resp = vbNo Then
        cancelacion.Show
        Exit Sub
    End If
    '
    Set l1 = ThisWorkbook
    'Abrir archivo de almacenamiento y cambio a hoja de llenado
    Ruta = l1.Path & "\GENERADOS\"
    archivo = "GENERADOR.xlsx"
    Set l2 = Workbooks.Open(Filename:=Ruta & archivo)
    'Seleccion y copiado de datos de las distintas tablas
    l1.Sheets("TABLA_PPTO").Range("A2:AR2341").Copy
    l2.Sheets("PPTO_DOT").Range("A2").PasteSpecial Paste:=xlPasteValues
    '
    l1.Sheets("TABLA_DOTACION").Range("A2:AR496").Copy
    l2.Sheets("PPTO_DOT").Range("A1").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
    '
    l1.Sheets("TABLA_DOTACION2").Range("A2:AR1441").Copy
    l2.Sheets("PPTO_DOT").Range("A1").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
    '
    l1.Sheets("TABLA_ENCUESTAS").Range("A2:AY19").Copy
    l2.Sheets("ENCUESTAS").Range("A2").PasteSpecial Paste:=xlPasteValues
    '
    'Guardado de archivo de envio
    nombre = l2.Sheets("ENCUESTAS").Range("D2").Value & "_" & l2.Sheets("ENCUESTAS").Range("N2").Value
    DatoFechador = Format(Now, "yyyymmdd hh.mm.ss")
    l2.SaveCopyAs Ruta & nombre & DatoFechador & ".xlsx"
    l2.Close False
    MsgBox "Arvhivo generado"
End Sub
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
Respuesta
-1

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas