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 SubEspero 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 de Alberto Jimenez Cabrera
1
Respuesta de Dante Amor
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 de Luis Laguna
-1
