EXPORTAR HOJA EXCEL A NUEVO LIBRO EXCEL CON NOMBRE DE UNA CELDA+TEXTO FIJO
Publicado por Quico (106 intervenciones) el 08/02/2019 06:32:24
Tengo una gráfica + macros en una hoja de un libro de varias páginas.
Me interesa exportar la parte de resultados de esa hoja, sin los botones macros. Eso se corresponde con Range("A2:V35").Select
En la gráfica, todas la celdas estan bloqueadas para que nadie altere resultados, pero si existe una única celda en la que hay que escribir a mano, un nombre X. Esa celda es "C4" y es la que ha de dar el nombre al nuevo libro excel.
En la macro, se pregunta el lugar dónde queremos guardarla, etc...., pero a la hora de guardarlo, me ofrece automaticamente solo el NOMBRE con el campo de texto fijo. ¡¡No encuentro la forma de que me reconoza el valor de C4!!
Esta es la parte dónde le indico el nombre:
GuardarComo = Application.GetSaveAsFilename(InitialFileName:=ruta & Cells(i, "C4") & "_Grafico_Resultados", _ <--AQUI FALLA LO DE Cells(i,"C4")
fileFilter:="Libro de Excel(*.xlsx), *.xlsx", _
Title:="xxx - guardar hoja excel como archivo nuevo.")
Y esta es la macro completa:
Sub ExportarEXCEL()
Dim xWs As Worksheet
Dim Rng As Range
Set Rng = Application.Selection
Dim ruta As String
Dim Titulo, Directorio As String
Titulo = "SELECCIONA UNA RUTA O CREA UNA CARPETA PARA GUARDAR EL EXCEL."
'Se genera un mensaje con WARNING informando sobre el proceso y con la posibilidad de cancelarlo.
If MsgBox("Antes de proceder, revisa el nombre correcto del grafico." & Chr(10) & "(celda azul correspondiente a C4)" & Chr(10) & " " & Chr(10) & " ¿ESTAS SEGURO DE PROCEDER AHORA?", vbYesNo + vbExclamation, "xxxxxx") = vbNo Then Exit Sub
'Elegimos la carpeta donde queremos guardar los archivos
On Error Resume Next
With CreateObject("shell.application")
ruta = .browseforfolder(0, Titulo, 0).Items.Item.Path
End With: On Error GoTo 0
'Si no elegimos la carpeta de destino, la macro se para
If ruta = Empty Then
MsgBox "SELECCIONA UNA CARPETA DE DESTINO", vbExclamation
Exit Sub
End If
'Selección de la parte a exportar a EXCEL
ru = ThisWorkbook.Path & "\"
Range("A2:V35").Select <--Le indicamos las celdas que ha de copiar
Application.Workbooks.Add
Set xWs = Application.ActiveSheet
Rng.Copy Destination:=xWs.Range("A1") <--Le indicamos que en el nuevo libro se copie en la celda A1
'NombreHoja = ActiveSheet.Name
Confirmacion = MsgBox("¿Desea guardar esta hoja como un archivo nuevo?", _
vbQuestion + vbYesNo, "xxxxx - Exportando Excel")
Application.ScreenUpdating = False
If Confirmacion = vbYes Then
ruta = ruta & "\" '<--Con esta variable le indicamos que se guarden los informes en la carpeta que hemos creado.
NombreArchivo = ActiveWorkbook.Name
GuardarComo = Application.GetSaveAsFilename(InitialFileName:=ruta & Cells(i, "C4") & "_Grafico_Resultados", _ <--AQUI FALLA LO DE Cells(i,"C4")
fileFilter:="Libro de Excel(*.xlsx), *.xlsx", _
Title:="xxx - guardar hoja excel como archivo nuevo.")
If GuardarComo = False Then
Workbooks(NombreArchivo).Close SaveChanges:=False
Else
With Application.WorksheetFunction
Extension = .Trim(Right(.Substitute(GuardarComo, ".", .Rept(" ", 500)), 500))
End With
Select Case Extension
Case Is = "xlsx"
ActiveWorkbook.SaveAs GuardarComo
Case Else
ActiveWorkbook.SaveAs GuardarComo
End Select
End If
Else
End If
' Para cerrar el nuevo excel creado
ActiveWorkbook.Close False
'Mensaje de texto de creación de carpetas
Respuesta = MsgBox("Se ha generado un nuevo archivo excel" & vbCrLf & " con resultados del mes." & vbCrLf & vbCrLf & " GRACIAS POR ESPERAR.", 64, "xxx- Exportando a EXCEL")
Exit Sub
End Sub
¿Alguien me puede ayudar a que indentifique la celda C4 como parte del nombre?
He probado Range ("C4") y tampoco me reconoce el contenido de la celda C4.
Gracias
Me interesa exportar la parte de resultados de esa hoja, sin los botones macros. Eso se corresponde con Range("A2:V35").Select
En la gráfica, todas la celdas estan bloqueadas para que nadie altere resultados, pero si existe una única celda en la que hay que escribir a mano, un nombre X. Esa celda es "C4" y es la que ha de dar el nombre al nuevo libro excel.
En la macro, se pregunta el lugar dónde queremos guardarla, etc...., pero a la hora de guardarlo, me ofrece automaticamente solo el NOMBRE con el campo de texto fijo. ¡¡No encuentro la forma de que me reconoza el valor de C4!!
Esta es la parte dónde le indico el nombre:
GuardarComo = Application.GetSaveAsFilename(InitialFileName:=ruta & Cells(i, "C4") & "_Grafico_Resultados", _ <--AQUI FALLA LO DE Cells(i,"C4")
fileFilter:="Libro de Excel(*.xlsx), *.xlsx", _
Title:="xxx - guardar hoja excel como archivo nuevo.")
Y esta es la macro completa:
Sub ExportarEXCEL()
Dim xWs As Worksheet
Dim Rng As Range
Set Rng = Application.Selection
Dim ruta As String
Dim Titulo, Directorio As String
Titulo = "SELECCIONA UNA RUTA O CREA UNA CARPETA PARA GUARDAR EL EXCEL."
'Se genera un mensaje con WARNING informando sobre el proceso y con la posibilidad de cancelarlo.
If MsgBox("Antes de proceder, revisa el nombre correcto del grafico." & Chr(10) & "(celda azul correspondiente a C4)" & Chr(10) & " " & Chr(10) & " ¿ESTAS SEGURO DE PROCEDER AHORA?", vbYesNo + vbExclamation, "xxxxxx") = vbNo Then Exit Sub
'Elegimos la carpeta donde queremos guardar los archivos
On Error Resume Next
With CreateObject("shell.application")
ruta = .browseforfolder(0, Titulo, 0).Items.Item.Path
End With: On Error GoTo 0
'Si no elegimos la carpeta de destino, la macro se para
If ruta = Empty Then
MsgBox "SELECCIONA UNA CARPETA DE DESTINO", vbExclamation
Exit Sub
End If
'Selección de la parte a exportar a EXCEL
ru = ThisWorkbook.Path & "\"
Range("A2:V35").Select <--Le indicamos las celdas que ha de copiar
Application.Workbooks.Add
Set xWs = Application.ActiveSheet
Rng.Copy Destination:=xWs.Range("A1") <--Le indicamos que en el nuevo libro se copie en la celda A1
'NombreHoja = ActiveSheet.Name
Confirmacion = MsgBox("¿Desea guardar esta hoja como un archivo nuevo?", _
vbQuestion + vbYesNo, "xxxxx - Exportando Excel")
Application.ScreenUpdating = False
If Confirmacion = vbYes Then
ruta = ruta & "\" '<--Con esta variable le indicamos que se guarden los informes en la carpeta que hemos creado.
NombreArchivo = ActiveWorkbook.Name
GuardarComo = Application.GetSaveAsFilename(InitialFileName:=ruta & Cells(i, "C4") & "_Grafico_Resultados", _ <--AQUI FALLA LO DE Cells(i,"C4")
fileFilter:="Libro de Excel(*.xlsx), *.xlsx", _
Title:="xxx - guardar hoja excel como archivo nuevo.")
If GuardarComo = False Then
Workbooks(NombreArchivo).Close SaveChanges:=False
Else
With Application.WorksheetFunction
Extension = .Trim(Right(.Substitute(GuardarComo, ".", .Rept(" ", 500)), 500))
End With
Select Case Extension
Case Is = "xlsx"
ActiveWorkbook.SaveAs GuardarComo
Case Else
ActiveWorkbook.SaveAs GuardarComo
End Select
End If
Else
End If
' Para cerrar el nuevo excel creado
ActiveWorkbook.Close False
'Mensaje de texto de creación de carpetas
Respuesta = MsgBox("Se ha generado un nuevo archivo excel" & vbCrLf & " con resultados del mes." & vbCrLf & vbCrLf & " GRACIAS POR ESPERAR.", 64, "xxx- Exportando a EXCEL")
Exit Sub
End Sub
¿Alguien me puede ayudar a que indentifique la celda C4 como parte del nombre?
He probado Range ("C4") y tampoco me reconoce el contenido de la celda C4.
Gracias
Valora esta pregunta
0