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