Saludos cordiales, estimados masters me puedne ayudar en verificar un macro que debe hacer lo siguiente:
En un rango C13:C500 al ingresar algun valor >0 se ejecuta una macro, caso contratio si el valor ingresado es 0 no debe hacer nada.
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Not Application.Intersect(Target, Range("C13:C500")) Is Nothing Then
Set Target = Range("C13:C500")
If Target.Value = 0 Then
Selection.Copy
Target.Offset(0, 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False
end if
end if
end sub
me sale error en If Target.Value = 0 Then
Gracias por su ayuda
Mar, 08/09/2020 - 03:28
#1
Ejecuta macro segun valor de celda
Hola Milton:
Prueba de esta manera para hacer lo que quieres. Luego nos comentas si es la solución que necesitabas.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Col As Integer 'COLUMNA DE LOS DATOS.
Dim FilI As Integer 'FILA DE INICIO DE LOS DATOS.
Dim FilF As Integer 'FILA FINAL DE LOS DATOS.
Col = 3 '----> COLUMNA C
FilI = 3 'FILA DE INICIO
FilF = 500 'FILA FINAL
Application.ScreenUpdating = False
If Target.Column = Col Then
If Target.Row >= FilI And Target.Row <= FilaF Then
If Target.Value = 0 And Target.Value <> "" Then
'INSERTA AQUI TU CODIGO
End If
End If
End If
Application.ScreenUpdating = True
End Sub
Un Saludo
FernandoML
Espero te sirva
Un Saludo
Fernando
saludos cordiales, la macro funciona para valores 0 pero cuando se ingresa un valor > 0 no funciona.
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Dim Col As Integer 'COLUMNA DE LOS DATOS.
Dim FilI As Integer 'FILA DE INICIO DE LOS DATOS.
Dim FilF As Integer 'FILA FINAL DE LOS DATOS.
Col = 3 '----> COLUMNA C
FilI = 13 'FILA DE INICIO
FilF = 932 'FILA FINAL
If Target.Column = Col Then
If Target.Row >= FilI And Target.Row <= FilaF Then
If Target.Value = 0 And Target.Value <> 0 Then
'INSERTA AQUI TU CODIGO
'---------------------------------------------------
If Not Application.Intersect(Target, Range("C13:C932")) Is Nothing Then
'SI HAY CAMBIOS SE UBICA A LA DERECHA E INSERTA CELDA EN COL. D
Target.Offset(0, 1).Select
Selection.Insert Shift:=xlDown
Target.Offset(0, 0).Select
'REGRESA A LA CELDA MODIFICADA Y COPIA SU CONTENIDO EN D
Selection.Copy
Target.Offset(0, 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Target.Offset(0, 2).Select
End If
End If
End If
End If
Application.ScreenUpdating = True
End Sub
Gracias por la ayuda
He añadido algunas lineas nuevas. Prueba si es lo que necesitabas y si necesitas alguna otra modificacion.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Col As Integer 'COLUMNA DE LOS DATOS.
Dim FilI As Integer 'FILA DE INICIO DE LOS DATOS.
Dim FilF As Integer 'FILA FINAL DE LOS DATOS.
'HE AÑADIDO ESTA LINEA PORQUE SI SELECCIONA UN RANGO PARA BORRAR VALORES
'EL CODIGO DA UN ERROR DE ESTA FORMA EVITAMOS ESTE PROBLEMA.
If InStr(1, Target.Address, ":", vbTextCompare) = 0 Then Exit Sub
Col = 3 'COLUMNA C
FilI = 3 'FILA DE INICIO
FilF = 500 'FILA FINAL
Application.ScreenUpdating = False
If Target.Column = Col Then
If Target.Row >= FilI And Target.Row <= FilF Then
If Target.Value = 0 And Target.Value <> "" Then
'CODIGO PARA LOS VALORES DE 0
MsgBox ("VALOR ES IGUAL A CERO")
ElseIf Target.Row > 0 Then
'CODIGO PARA VALORES > 0
MsgBox "VALOR MAYOR DE CERO"
End If
End If
End If
Application.ScreenUpdating = True
End Sub
Espero te sirva
Un Saludo
Fernando
Exelente aporte, es lo que necesito
Tema cerrado
Gracias siempre