Clic a celda, seleccionar datos y pasar a otra hoja acomodados

Tengo una hoja1 que tiene distintos datos que necesito pegar en orden en la hoja2

Para eso tengo este código:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
ActiveWindow.DisplayVerticalScrollBar = False
ActiveWindow.DisplayHorizontalScrollBar = False
ExecuteExcel4Macro ("show.toolbar(""ribbon"",1)")
'x Elsamatilde
'controla que se esté seleccionando celda en col A
If Intersect(Target, Columns("B")) Is Nothing Then Exit Sub
'controla que se haya seleccionado 1 sola celda
If Target.Count > 1 Then Exit Sub
Dim respuesta As Variant
cantidad = InputBox("Si estás seguro, captura la cantidad:", "Seleccionaste: " & Range("B" & Target.Row))
'If cantidad = "1" Or cantidad > "1" Then 'Application.Speech.Speak "Seleccionaste: " & Range("B" & Target.Row)
If cantidad = 0 Or cantidad = "" Then Exit Sub
Application.ScreenUpdating = False
Sheets("REP X TURNO").Select
'si la celda activa está fuera del rango 10:23 no se ejecuta
If ActiveCell.Row < 10 Or ActiveCell.Row > 23 Then
MsgBox "Ya no hay filas para ingresar productos.", , "ERROR"
'EVALUA AQUÍ A QUÉ HOJA REGRESAR
Exit Sub
End If
'ya estará la celda destino seleccionada
'desprotejo
ActiveSheet.Unprotect "28021990"
'ActiveSheet.Range("D" & ActiveCell.Row) = Cells(Target.Row, "A") 'clave
ActiveSheet.Range("I" & ActiveCell.Row) = Cells(Target.Row, "B") 'producto
ActiveSheet.Range("L" & ActiveCell.Row) = Cells(Target.Row, "C") 'precio
ActiveSheet.Range("F" & ActiveCell.Row) = cantidad
'se vuelve a proteger
ActiveSheet.Protect "28021990"
'pasar a la fila sgte para seguir agregando productos a hoja NOTA
ActiveCell.Offset(1, 0).Select
'vuelvo a la hoja VER PRODUCTO
Sheets(Hoja1.Name).Select
End Sub

Me funciona pero no en lo que necesito.

Lo que necesito es que así como me pide que yo ingrese cantidad (en esta parte)

cantidad = InputBox("Si estás seguro, captura la cantidad:", "Seleccionaste: " & Range("B" & Target.Row))

Así me pida (imputbox)

FECHA

Y este me lo pegue de manera que se pueda entender.

Actualmente el código funciona así.

En la hoja1 lo tengo así (por 2 columnas ):

            producto                   precio unitario

              danes                               $10.00

al ejecutar el código

esto lo pega en la hoja2 (por  3 columnas ) :

cantidad         producto                    precio

  5                        danes                    $50.00 (aqui tengo formula de cantidad x precio unitario)

(no hay fecha) :c

Entonces yo quisiera un código que prácticamente funcione igual solo que me pida fecha y me pegue los datos así (algo más estético por 3 columnas pero así)

producto                                                         fecha                                        precio

5 danes (concatenado en codigo)           30/7/2015                  (con codigo sin formula)$50.00

Otra cosa que le pasa al código es que si en la hoja2 no estoy situando en el rango de donde pegar este no me permite:

'si la celda activa está fuera del rango 10:23 no se ejecuta
If ActiveCell.Row < 10 Or ActiveCell.Row > 23 Then

Entonces necesito que el código siempre me posicione en ese rango al momento de ejecutarse. (Este o no este posicionado).

Y por ultimo que tiene el código anterior que:

Estando en el rango del código si tengo datos en la fila 10 y me posciono de nuevo en la fila 10 este me borra los datos y me pone los nuevos (esto es bueno pero no lo necesito)

'pasar a la fila siguiente para seguir agregando productos a hoja NOTA
ActiveCell.Offset(1, 0).Select

Lo que NECESITO es que si tiene datos en ese rango este me pase al siguiente fila vacía. Solo sera posible reemplazar datos siempre y cuando alguna fila este vacía si no lo esta entonces que avise con algún msgbox. (Me posicione en una fila con datos este no lo borre)

1 Respuesta

Respuesta
1

Te anexo la macro actualizada

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Act.Por.Dante Amor
    'ActiveWindow.DisplayVerticalScrollBar = False
    'ActiveWindow.DisplayHorizontalScrollBar = False
    'ExecuteExcel4Macro ("show.toolbar(""ribbon"",1)")
    If Intersect(Target, Columns("B")) Is Nothing Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    cantidad = InputBox("Si estás seguro, captura la cantidad:", "Seleccionaste: " & Range("B" & Target.Row))
    If cantidad = 0 Or cantidad = "" Then Exit Sub
    '
    fecha = InputBox("Ingresa fecha: ")
    If fecha = 0 Or fecha = "" Then Exit Sub
    '
    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 "Ya no hay filas para ingresar productos.", vbCritical, "ERROR"
        Exit Sub
    End If
    h1.Unprotect "28021990"
    h1.Cells(i, "I") = cantidad & " " & Cells(Target.Row, "B") 'Cantidad y producto
    h1.Cells(i, "L") = fecha                                   'Fecha
    h1.Cells(i, "F") = Cells(Target.Row, "C") * cantidad       'Cantidad * precio
    h1.Protect "28021990"
End Sub

Solamente tengo duda en dónde quieres los nuevos datos, los puse en el orden en que están en la macro, en la columna I = cantidad y el producro, en la L la fecha, en la F la cantidad por el precio. Revisa si puedes adaptarlo. Si tienes problemas avísame.

S a l u d o s

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas