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
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