Mal funcionamiento de código para copiar valor variable en celda definida por otras variables

Escribir valor de variable en una confluencia (que varía)... Siempre :-)

Hice una macro para el control mensual de entregas. Parecía algo sencillo, pero me he topado con un problema al que no le encuentro solución.

Básicamente, la macro comprueba, por si está, el dato ENTREGA en la hoja Jornadas (si está, debería escribir el dato SITUADO en la celda correspondiente y terminar), si no está comprueba Conocidos (aviso de que no se introduce y termina), si no está va a Desconocidos (si no está vuelve a Jornadas a escribir el dato y si está copia el dato y va a Jornadas).

Se supone que al final de la macro en la celda donde confluye los datos obtenidos del formulario (variables DIA y ENTREGA) se debería escribir el valor de SITUADO.

Entrega           Observ.  Propiet.  1  2  3 4 5 6 7 8 9 10....   (P: Parking, M: Mercado,...)

ENTREGA01  Bici          Juan       P      M

Esto funciona bien la primera vez cuando es una ENTREGA nueva (que no está registrada), pero el problema es que si ENTREGA ya está en anotada, el valor de la variable se escribe algunas casillas más allá de donde le corresponde.

Creo que el problema está aquí:

'SI ESTÁ en JORNADAS copiamos el día # para mover el cursor a la celda fecha
If Not busca Is Nothing Then
' Selection.Cells(1, 1).Select
ActiveCell.Activate
fecha = (2 + quedia)
ActiveCell.Offset(0, fecha).Activate
ActiveCell = quelugar
Exit Sub

PERO pongo todo el código (prefería anexar el xls pero no fuí capaz):

Sub buscarypegar()
quebusco = Worksheets("Hoja1").Range("A1").Value
quedia = Worksheets("Hoja1").Range("B1").Value
quelugar = Worksheets("Hoja1").Range("C1").Value
If quebusco = "" Then Exit Sub 'Por si CELDA VACIA
'COMPROBAR si YA ESTÁ la matrícula ANOTADA
Worksheets("Jornadas").Activate
Set busca = ActiveSheet.Range("a2:a" & Range("a10000").End(xlUp).Row).Find(quebusco, LookIn:=xlValues, LookAt:=xlWhole)
'SI ESTÁ en JORNADAS copiamos el día # para mover el cursor a la celda fecha
If Not busca Is Nothing Then
' Selection.Cells(1, 1).Select
ActiveCell.Activate
fecha = (2 + quedia)
ActiveCell.Offset(0, fecha).Activate
ActiveCell = quelugar
Exit Sub

Else
'COMPROBAR si YA ESTÁ REGISTRADA
Worksheets("Conocidos").Activate
Set busca = ActiveSheet.Range("a2:a" & Range("a10000").End(xlUp).Row).Find(quebusco, LookIn:=xlValues, LookAt:=xlWhole)
If Not busca Is Nothing Then
Worksheets("Jornadas").Activate
MsgBox "Esta matrícula ya está en el listado de matrículas registradas." & vbNewLine & "No tienes que añadirla", , " ***Mensaje especial***"
Exit Sub
Else
'si no está registrada COMPROBAR si está en DESCONOCIDOS
Worksheets("Desconocidos").Activate
Set busca = ActiveSheet.Range("a2:a" & Range("a10000").End(xlUp).Row).Find(quebusco, LookIn:=xlValues, LookAt:=xlWhole)
If Not busca Is Nothing Then
Range("A" & busca.Row & ":C" & busca.Row).Copy
Worksheets("Jornadas").Activate
Range("A1").Select
Cells.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False).Activate
Sheets("Jornadas").Cells(Range("a10000").End(xlUp).Row + 1, 1).PasteSpecial Paste:=xlValues
' vamos a copiar el día para mover el cursor a la celda fecha
' Selection.Cells(1, 1).Select
ActiveCell.Activate
fecha = (2 + quedia)
ActiveCell.Offset(0, fecha).Activate
ActiveCell = quelugar
Exit Sub

Else
'esto es para cuando es nueva la matrícula
Worksheets("Jornadas").Activate
Range("A1").Select
Cells.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False).Activate
' vamos a copiar el día para mover el cursor a la celda fecha
ActiveCell = quebusco
' Selection.Cells(1, 1).Select
ActiveCell.Activate
fecha = (2 + quedia)
ActiveCell.Offset(0, fecha).Activate
ActiveCell = quelugar
Exit Sub

End If
End If
End If
Application.CutCopyMode = False
' copiarypegar
End Sub

1 respuesta

Respuesta
1

Cambia esto:

'SI ESTÁ en JORNADAS copiamos el día # para mover el cursor a la celda fecha
If Not busca Is Nothing Then
' Selection.Cells(1, 1).Select
ActiveCell.Activate
fecha = (2 + quedia)
ActiveCell.Offset(0, fecha).Activate
ActiveCell = quelugar
Exit Sub

Por esto:

    'SI ESTÁ en JORNADAS copiamos el día # para mover el cursor a la celda fecha
    If Not busca Is Nothing Then
        '   Selection.Cells(1, 1).Select
        busca.Select
        'ActiveCell.Activate
        fecha = (2 + quedia)
        ActiveCell.Offset(0, fecha).Activate
        ActiveCell = quelugar
        Exit Sub

'.[Sal u dos. Dante Amor. No olvides valorar la respuesta. 
'.[Avísame cualquier duda

Gracias por tu pronta respuesta. la línea de código que sustituimos no ha dado resultado. Sigue haciendo cosas erráticas como antes.  te adjunto muna imagen de como está para poder aclararlo.

 He puesto en Entrega: E1 Día: 1 Situado: M. La primera vez funciona. Luego escribo en Día: 2 y 3 con el resultado que se ve... no es 1 2 3... M M M sino que queda 1M, 5M, 10 M.

Le pediría que mirara la macro que le envié por si el problema está en otra orden.

Yo hice pruebas y si la entrega existe, entonces pone correctamente el día. Probé varias veces con E1 del día 1 hasta el día 4 y lo hace bien.

Puedes poner nuevamente todo el código para ver qué tienes.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas