0

resulta que tengo el siguiente código

Private Sub cmdexp_Click()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

On Error Resume Next
Dim myfile, mybook, a, b, c As String
rng As Excel.Range
Ruta = ActiveWorkbook.Path
ChDir Ruta

myfile = Application.GetOpenFilename("Archivos Excel (*.xl*), *.xl*")
If VarType(myfile) = vbBoolean Then
MsgBox ("Operación cancelada"), vbCritical, "AVISO"
Exit Sub
End If

mybook = ActiveWorkbook.Name
Workbooks.Open Filename:=myfile, UpdateLinks:=0
FullName = Split(myfile, Application.PathSeparator)
a = FullName(UBound(FullName))

'Set b = Sheets(ActiveSheet.Name)
'b.Cells.Clear

Workbooks(mybook).Sheets("Chequeo Plano").UsedRange.Copy Destination:=Workbooks(a).Sheets("DATOS RED").Cells(1, 1)
Workbooks(a).Sheets("DATOS RED").Cells(1, 1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Workbooks(a).Close True

MsgBox ("Los datos se exportaron con éxito"), vbInformation, "AVISO"
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Con ese código hago una exportación de datos entre libros de excel, pero hay algunos detalles con los cuales me gustaría pedir su ayuda, los cuales son:

1- Actualmente se esta haciendo un pegado especial (esto se hace ya que los datos originales contienen formulas y yo solo necesito los resultados de dichas formulas), la cuestión es que también necesito que se copie el formato y al estar usando el pegado especial el formato no se copia, ¿como puedo hacer para que el formato también se exporte?

2- Luego del aviso de:

"Los datos se exportaron con éxito"

Necesito que se abra una nueva ventana emergente preguntando al usuario si desea abrir el archivo, y si el le da click a "Si", le abra el archivo llamado " MEMORIAS GPZC 1179.xlsm "

Antes cualquier ayuda, muchas gracias

1 respuesta 1

0

Hola Stefa te comparto el codigo con tus solicitudes, si encuentras util mi respuesta te agradecere tu apoyo y comentarios.

Private Sub cmdexp_Click()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

On Error Resume Next
Dim myfile, mybook, a, b, c As String
rng As Excel.Range
Ruta = ActiveWorkbook.Path
ChDir Ruta

myfile = Application.GetOpenFilename("Archivos Excel (*.xl*), *.xl*")
If VarType(myfile) = vbBoolean Then
MsgBox ("Operación cancelada"), vbCritical, "AVISO"
Exit Sub
End If

mybook = ActiveWorkbook.Name
Workbooks.Open Filename:=myfile, UpdateLinks:=0
FullName = Split(myfile, Application.PathSeparator)
a = FullName(UBound(FullName))

'Set b = Sheets(ActiveSheet.Name)
'b.Cells.Clear

Workbooks(mybook).Sheets("Chequeo Plano").UsedRange.Copy

' ** MODIFICACION
With Workbooks(a).Sheets("DATOS RED").Cells(1, 1)
.PasteSpecial xlFormats
.PasteSpecial xlPasteValues
End With
' ** FIN

Application.CutCopyMode = False
Workbooks(a).Close True

MsgBox ("Los datos se exportaron con éxito"), vbInformation, "AVISO"

Dim file_name As String
Dim file_path As String

file_name = "MEMORIAS GPZC 1179.xlsm"
file_path = "C:\Users\USUARIO\Desktop\" & file_name

pregunta = MsgBox("Deseas abrir archivo excel de nombre: " & file_name, vbYesNo)

If pregunta = vbYes Then
Excel.Application.Workbooks.Open file_path
Else
MsgBox "No se abrira ningun archivo"
End If

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub
5
  • 1
    Es recomendable explicar que partes se han modificado y por qué, para que se pueda entender dónde estaban los fallos en la pregunta o como se ha ayudado a resolver el problema.
    – Wyrncael
    el 9 abr. 2018 a las 23:05
  • @Wyrncael gracias, agregare los comentarios en breve.
    – warner_sc
    el 10 abr. 2018 a las 0:17
  • @hot_potato, Hola, primero gracias por tu ayuda la parte de exportar el formato y de preguntar si quiere abrir el archivo funcionan a la perfección, pero las formulas se siguen exportando lo que provoca que en el archivo donde se envían los datos tenga celdas con errores del tipo #¿NOMBRE?
    – user74220
    el 10 abr. 2018 a las 13:56
  • @stefazapata Listo, existe un detalle en el codigo que no cambie pero ahora debera de funcionar!
    – warner_sc
    el 10 abr. 2018 a las 14:46
  • @hot_potato, ahora funciona todo funciona a la perfección, te lo agradezco mucho
    – user74220
    el 10 abr. 2018 a las 15:27

Tu Respuesta

By clicking “Publica tu respuesta”, you agree to our terms of service and acknowledge you have read our privacy policy.