Interrupcion en un worksheet

Purimerino

New Member
Joined
Dec 26, 2016
Messages
1
Buenas tardes, tengo creado un worksheet para un cambio en un rango de celdas de una hoja que contiene un filtro de una base de datos, de tal forma, que si hay cambio me actualice la linea correspondiente de la base de datos que tengo en otra hoja. Dentro del worksheet llamo a una macro que es la que me busaca la linea a actualizar. Bien el proceso funciona y llega a actualizar los datos, pero se interrumpe ahi sin terminar el worksheet, por lo que en la hoja donde se han cambiado los datos me queda seleccionada y parpadeando la linea donde se produjo el cambio. Lo que quiero es saber que falta el codigo para rematar el worksheet que se disparo con el cambio y que quede todo como finalizado. Añado mis codigos. Gracias

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
On Error GoTo Error
Dim KeyCells As Range
Dim Fila
Dim Valor As String
Dim sFormat As String
Dim Celda As Range
' The variable KeyCells contains the cells that will
' cause an alert when they are changed.
Set KeyCells = Range("A9:P104756")

If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then

' Display a message when one of the designated cells has been
' changed.

MsgBox "Celda " & Target.Address & " ha cambiado."
Dim Resp As Byte
Resp = MsgBox("Deseas actualizar la base de datos?", _
vbQuestion + vbYesNo, "Atención")
If Resp = vbYes Then
MsgBox "Se actualizará la base de datos...", vbExclamation, "Atención"
'Aquí se ejecutaría el código
Range(Target.Address).Select
Range("B" & ActiveCell.Row).Select
Set Celda = ActiveCell
Range("B6") = Celda.Value
Selection.EntireRow.Select
Selection.Copy

Call ActualizarBase
Else
MsgBox "Se deshará el valor introducido...", vbCritical, "Atención"
Application.Undo

End If

End If
Error:
Application.EnableEvents = True
End Sub


Y la macro a la que llamo es:

Sub ActualizarBase()
'
' Actualizar el registro
'

'
Sheets("BASE DE DATOS").Select
Dato = Range("A2")
Columns("B:B").Select
Selection.Find(What:=Dato, After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext + 1, MatchCase:= _
False, SearchFormat:=True).Activate
ActiveCell.Offset(0, 0).Select
Selection.EntireRow.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
MsgBox "Base actualizada"
End Sub

Saludos y gracias
 

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.

Forum statistics

Threads
1,213,536
Messages
6,114,208
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top