Modificacion2 de codigo que traspasa informacion de una hoja a otra

Recientemente me ayudaron con este codigo hecho por el experto DAN

Private Sub Worksheet_Change(ByVal Target As Range)
'Act.Por.Dante Amor
'ActiveWindow.DisplayVerticalScrollBar = False
'ActiveWindow.DisplayHorizontalScrollBar = False
'ExecuteExcel4Macro ("show.toolbar(""ribbon"",1)")
If Intersect(Target, Range("j7:j920,v7:v920,ah7:ah920,at7:at920,bf7:bf920,br7:br920,cd7:cd920,CP7:CP920,DB7:DB920,DN7:DN920,DZ7:DZ920,EL7:EL920,EX7:EX920,FJ7:FJ920")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Not IsNumeric(Target) Then Exit Sub
'
Target.Select
Set h1 = Sheets("REP X TURNO")
existe = False
For i = 10 To 23
If h1.Cells(i, "I") = "" Then
existe = True
Exit For
End If
Next
If existe = False Then
MsgBox "Limite de Degustaciones Alcanzado", vbCritical, "ERROR"
Exit Sub
End If
cantidad = Application.InputBox("Cantidad a Degustar: ", "Ingresar", Target)
If cantidad = 0 Or cantidad = "" Then
Application.EnableEvents = False
Target = ""
Application.EnableEvents = True
Exit Sub
End If
'
fecha = Application.InputBox("fecha de Degustación: ", "INGRESAR", Format(Cells(965, Target.Column), "MM/DD/yyyy"))
If fecha = 0 Or fecha = "" Then
Application.EnableEvents = False
Target = ""
Application.EnableEvents = True
Exit Sub
End If
'
h1.Unprotect
h1.Cells(i, "I") = cantidad & " " & Cells(Target.Row, "B") 'Cantidad y producto
h1.Cells(i, "J") = fecha 'Fecha
h1.Cells(i, "K") = Cells(Target.Row, "C") * cantidad 'Cantidad * precio
h1.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True
End Sub

Funciona realmente excelente todo lo que necesitaba...

Pero como lo fui usando me salio otro detalle no del codigo si no en la forma de trabajar mia..

el detalle es el sig...

al poner en alguna celda de estos rangos:

If Intersect(Target, Range("j7:j920,v7:v920,ah7:ah920,at7:at920,bf7:bf920,br7:br920,cd7:cd920,CP7:CP920,DB7:DB920,DN7:DN920,DZ7:DZ920,EL7:EL920,EX7:EX920,FJ7:FJ920")) Is Nothing Then Exit Sub

este me pone el numero ingresado en:

cantidad = Application.InputBox("Cantidad a Degustar: ", "Ingresar", Target)

posteriormente la fecha:

fecha = Application.InputBox("fecha de Degustación: ", "INGRESAR",

Si le dan cancelar este no procede y borra la cantidad que yo puse en la celda de mi rango lo cual es genial...

Pero usando el codigo me tope con el problema mio...

Una vez ejecutado el codigo este ya se paso a donde indica y se protege...

Lo que necesito es:

Que si en "BF200" yo puse 5 de cantidad y se ejecuta el codigo bien y todo eso...

Quisiera que si en "BF200" al eliminar la cantidad que puse entonces tambien se elimine los datos que se traspasaron ala hoja destino..

Eso es el detalle la eliminacion de cantidad en la hoja original y que tambien elimine los datos pegados en la hoja destino..

1 respuesta

Respuesta
1

H o l a:

Te explico, lo que pides es muy complicado realizarlo.

Te explico con un ejemplo:

  • Escribes en la celda J7 la cantidad 5, entonces en la hoja "REP X TURNO", celda "I10" se almacena un 5.
  • Escribes en la celda J8 un 5, en "REP X TURNO", celda "I11" se almacena un 5.
  • Escribes en J9 un 5, en "REP X TURNO", celda "I12" se almacena un 5.
  • Ahora quieres realizar una actualización, borras el número 5 que está en la celda J8.

¿Cómo saber cuál de los tres 5 que están en la hoja "REP X TURNO" es el que se tiene que borrar?


Para lograr lo anterior se tendría que levar en una hoja el control de cambios, entonces para cada cambio que hagas en el rango, se tendría que actualizar la hoja "control", por ejemplo:

  • Escribes en la celda J7 la cantidad 5, entonces en la hoja "REP X TURNO", celda "I10" se almacena un 5. En la hoja "control": A1 =J7, B1 = 5, C1 = I10
  • Escribes en la celda J8 un 5, en "REP X TURNO", celda "I11" se almacena un 5. En la hoja "control": A2 =J8, B2 = 5, C2 = I11
  • Escribes en J9 un 5, en "REP X TURNO", celda "I12" se almacena un 5. En la hoja "control": A3 =J9, B3 = 5, C3 = I12
  • Ahora quieres realizar una actualización, borras el número 5 que está en la celda J8. Tienes que revisar en la hoja "control" si la existe la celda J8 en la columna "A", si existe, tienes que tomar la celda que está en la columna "C", en este caso toma el dato "I11", entonces vas a la hoja "REP X TURNO" y borras el contenido de la celda "I11". En la hoja "control": A4 =J8, B4 = "", C4 = I11

Eso es solamente un ejemplo de lo que tienes que llevar en la hoja "control", pero todo, absolutamente todo lo que hagas en la hoja "REP X TURNO", tendrás que replicarlo en la hoja "control", además de llevar el control, será como una especie de histórico, entonces si haces 500 cambios en la hoja "REP X TURNO", tendrás 500 registros en la hoja "control" y siempre deberás revisar del último registro hacia arriba para determinar cuál fue la última actualización.

Es demasiado control para la hoja "REP X TURNO", para las celdas de la I10 a la I23.


Veo más fácil que hagas una macro en la hoja "REP X TURNO", en la que le digas cuál celda quieres borrar, qué desproteja la hoja, borre la celda, se recorran las celdas hacia arriba y vuelva a proteger la hoja.

'

S a l u d o s

Si ya entendí si se oye complicado... en este caso:

Veo más fácil que hagas una macro en la hoja "REP POR TURNO", en la que le digas cuál celda quieres borrar, qué desproteja la hoja, borre la celda, se recorran las celdas hacia arriba y vuelva a proteger la hoja.

¿Cómo funcionaria la macro? ¿Si por ejemplo borro en mi hoja la cantidad 5 entonces me avisa? ¿Debes borrar en la hoja REP POR TURNO? ¿O algo así?

¿Cómo quedaría más o menos la macro?

Ejemplo yo pongo 5 en J3 digamos y en I10 pone esos 5 junto con el nombre del producto la fecha y el importe...

¿Cómo realizo esto?

Una macro en la hoja "REP POR TURNO", en la que le digas cuál celda quieres borrar

Digamos que quiero que me borre si la fecha de mi hoja inicial coincide con la fecha que pegue, o si el producto coincide con el que borre...

¿

no se algo así no? No se me ocurre algo :S

Es una macro independiente, tendrías que estar en la hoja "REP X TURNO", seleccionar una celda y ejecutar una macro presionando un botón para que borre el contenido de esa celda.

¿Algo sencillo como esto?

Para que pueda borrar la 3 celdas PRODUCTO, FECHA E IMPORTE...

En caso de borrar algo en la celdas donde me aparecen los imputbox del código de arriba, no me puede salir un msgbox que indique que tiene que borrar en REp POR TURNO esto como un recordatorio, ya yo pongo este código en REP POR TURNO:

ActiveSheet.Unprotect
Selection.ClearContents
ActiveSheet.Protect

Después de esta línea:

If Target.Count > 1 Then Exit Sub

Pon:

If target.value = "" then

   msgbox "Recuerda borrar en REP X TURNO"

End If


Para borrar las 3 celdas:

 ActiveSheet. Unprotect
    fila = ActiveCell.Row
    Cells(fila, "I"). ClearContents
    Cells(fila, "J"). ClearContents
    Cells(fila, "K"). ClearContents
    ActiveSheet.Protect

 S a l u d o s

MIRA realice esto...

Este es el código que me tienes dado

Private Sub Worksheet_Change(ByVal Target As Range)
'Act.Por.Dante Amor
'ActiveWindow.DisplayVerticalScrollBar = False
'ActiveWindow.DisplayHorizontalScrollBar = False
'ExecuteExcel4Macro ("show.toolbar(""ribbon"",1)")


If Intersect(Target, Range("j7:j920,v7:v920,ah7:ah920,at7:at920,bf7:bf920,br7:br920,cd7:cd920,CP7:CP920,DB7:DB920,DN7:DN920,DZ7:DZ920,EL7:EL920,EX7:EX920,FJ7:FJ920")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Target.Value = "" Then
ELIMINACIONES.Show
End If
If Not IsNumeric(Target) Then Exit Sub
'
Target.Select
Set h1 = Sheets("REP X TURNO")
'''Set h2 = Sheets("REP X TURNO2")
existe = False
For i = 10 To 23
If h1.Cells(i, "I") = "" Then ''''Or h2.Cells(i, "J") = ""
existe = True
Exit For
End If
Next
If existe = False Then
MsgBox "Limite de Degustaciones Alcanzado", vbCritical, "ERROR"
Exit Sub
End If
cantidad = Application.InputBox("Cantidad a Degustar: ", "Ingresar", Target)
If cantidad = 0 Or cantidad = "" Then
Application.EnableEvents = False
Target = ""
Application.EnableEvents = True
Exit Sub
End If
'
fecha = Application.InputBox("fecha de Degustación: ", "INGRESAR", Format(Cells(965, Target.Column), "MM/DD/yyyy"))
If fecha = 0 Or fecha = "" Then
Application.EnableEvents = False
Target = ""
Application.EnableEvents = True
Exit Sub
End If
'
h1.Unprotect
h1.Cells(i, "I") = cantidad & " " & Cells(Target.Row, "B") 'Cantidad y producto
h1.Cells(i, "J") = fecha 'Fecha
h1.Cells(i, "K") = Cells(Target.Row, "C") * cantidad 'Cantidad * precio
h1.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True
'''h2.Unprotect
'''h2.Cells(i, "J") = cantidad & " " & Cells(Target.Row, "B") 'Cantidad y producto
'''h2.Cells(i, "K") = fecha 'Fecha
'''h2.Cells(i, "L") = Cells(Target.Row, "C") * cantidad 'Cantidad * precio
''' h2.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True

End Sub

Al principio intente modificarlo para que copie en las 2 hojas qUe tengo, una llamada REP POR TURNO y otra llamada REP POR TURNO2

entoces cree esto....

'Eliminar el registro
Private Sub CommandButton4_Click()

Pregunta = MsgBox("Está seguro de eliminar el registro?", vbYesNo + vbQuestion, "INFO")
If Pregunta <> vbNo Then


Fila = Me.ListBox1.ListIndex + 10 'UNO ANTES DEL ENCABEZADO PARA QUE AGARRE LOS VALORES
Sheets("REP X TURNO").Unprotect
Sheets("REP X TURNO").Cells(Fila, 9).ClearContents 'COLUMNA Y CELDA APARTIR DE LA POSICION INDIVIDUAL PARA BORRAR (1) ES DESDE DONDE ESTAS
Sheets("REP X TURNO").Cells(Fila, 10).ClearContents
Sheets("REP X TURNO").Cells(Fila, 11).ClearContents
'Cells(Fila, 24).ClearContents
Sheets("REP X TURNO").Protect
Application.ScreenUpdating = True

End If
End Sub
'
'Activar la celda del registro elegido
Private Sub ListBox1_Click()

Fila = Me.ListBox1.ListIndex + 9 'UNO ANTES DEL ENCABEZADO PARA QUE AGARRE LOS VALORES
For i = 1 To 16
'Cells(Fila, 9).Activate 'NUMERO DE COLUMNA PARA SITUARTE
Next i
End Sub
'Dar formato al ListBox y traer datos de la tabla
Private Sub UserForm_Initialize()
With ListBox1
.ColumnCount = 11
.ColumnWidths = "60 pt;60 pt;70 pt"
.ColumnHeads = True
End With
ListBox1.RowSource = "Tabla1"
End Sub

que al darme esto lo hablo

If Target.Value = "" Then
ELIMINACIONES.Show

a lo que sale algo como esto:

Y lo elimino desde mi hoja mostrándome los datos que ya traspase y eliminando lo que hice...

El único detalle que tengo es que al borrarlo me sale el imputbox como si fuera a poner algo... no se como hacer que no aparezca si no tiene nada..

Esta es la hoja en que lo pego... NO SE SI ESTOY BIEN EN LOS CÓDIGOS QUE TENGO EN EL FORMULARIO (le podrías dar un VO.BO.)

Esta es la hoja en donde se traspasa todo_

Espero tus observaciones... sugerencias o consejos :D

Entonces después de esta línea

ELIMINACIONES.Show

Pon:

Exit sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas