Buscar, copiar y pegar
Hola amigos, de nuevo por aca, sigo con un programita para control de tarjetas de cobro. El código es este…
Sub buscar()
Dim lookupvalue As Variant, value As Variant, lookupRange As Range
value = Range("H3").value 'celda con el valor que buscamos (Pagada, cancelada, abonada, etc)
Set lookupRange = Range("C40:E100") 'rango donde buscar
lookupvalue = Application.VLookup(value, lookupRange, Range("H4"), False) 'Queremos la columna 2
'Si no encuentra valor finaliza
If IsError(lookupvalue) Then
Exit Sub
MsgBox lookupvalue
'Necesito agregar al resultado visualizado en el MsgBox el contenido de la celda anterior 'izquierda de esa encontrada.
'Además, al hacer click en "Aceptar" de este MsgBox, copiar estos dos contenidos encontrado ((B:C) por ejem.) y pegar en A:B respectivamente de la última fila de la hoja2... Continuar buscando el mismo valor hasta agotarse y finalizar.
Else
End If
'Range("D40").Select
End Sub
Agradezco sus atenciones.
2 Respuestas
Enseguida te mando un ejemplo.
Una aclaración: cuando dices que quieres el valor de la celda anterior izquierda ¿sería cómo este ejemplo:?
Ejemplo:
Buscamos la palabra cancelada en la columna C y por ejemplo se encuentra la primera en la celda C54, ¿entonces tu quieres el valor de la celda C53?
Muchas gracias Luis...aclarando...si la palabra buscada se encuentra en la celda C54, entonces la celda requerida es la B54, luego entonces, al cliquear "Aceptar" en el MsgBox,
la rutina debe cortar (o copiar y después borrar) las celdas B54 y C54 y transferirlas a la ultima fila A y B del destino hoja2, u hoja3, y asi sucesivamente... de nuevo muchas gracias y disculpa por la tardanza involuntaria,.
Te mando mi solución:
Tenemos los datos en hoja1 y lo que encontremos lo pegará en hoja2 al ejecutar esta macro:
Sub ejemplo()
'por luismondelo
fila = Sheets("hoja2").Range("a65000").End(xlUp).Row + 1
dato = InputBox("que dato buscamos???")
If dato = "" Then Exit Sub
Set busca = Sheets("hoja1").Range("c40:c100").Find(dato, LookIn:=xlValues, lookat:=xlWhole)
If Not busca Is Nothing Then
ubica = busca.Address
Do
Sheets("hoja2").Cells(fila, 2).Value = busca
Sheets("hoja2").Cells(fila, 1).Value = busca.Offset(0, -1)
fila = fila + 1
Set busca = ActiveSheet.Range("c40:c100").FindNext(busca)
Loop While Not busca Is Nothing And busca.Address <> ubica
End If
End Subno olvides finalizar la consulta
Hola Luis… fíjate que ya estuve tratando de intercalar en mi código las formulas que me proporcionaste pero no encuentro adaptación. Quiero decirte que hasta donde llegué con mi código es que este me ofrece en la ventana del MsgBox el resultado de la búsqueda solo que los dos elementos encontrados aparecen unidos (ejem. “3265Cancelada”) .Lo que me falta es: por una parte, que estos dos elementos queden separados por un espacio; y por otra, con el click en “Aceptar”; a).- se copien las dos celdas en que se encuentran “B y C” “3265Cancelada”; b).- se peguen estos dos contenidos en la última fila de la hoja2. Y d).- se borre “B y C”, pues sus contenidos se transfieren a otro destino.
((En este caso del ejemplo, la palabra “Cancelada” es la buscada y en la ejecución se encuentro en la celda C54, por efecto el número 3265 se localiza en la celda B54.)). No se si estoy bien en la pregunta, pues se me hacen demasiadas, pero creo que en un click se pueden ejecutar.
Agradezco de nuevo tus atenciones. Muchísimas gracias.
Mi código no tiene que ver nada con el tuyo, es todo nuevo. Yo creo que será mejor que me mandes tu archivo y me expliques un ejemplo de forma detallada.
Reemplaza la macro, por esta.
‘***Macro
Sub buscar()
Dim lookupvalue As Variant, value As Variant, lookupRange As Range
value = Range("H3").value 'celda con el valor que buscamos (Pagada, cancelada, abonada, etc)
Set lookupRange = Range("C40:E100") 'rango donde buscar
lookupvalue = Application.VLookup(value, lookupRange, Range("H4"), False) 'Queremos la columna 2
'Si no encuentra valor finaliza
If IsError(lookupvalue) Then
Exit Sub
Else
Lookupvalue1 = Application.VLookup(value, lookupRange, val(Range("H4")) -1, False)
MsgBox lookupvalue & lookupvalue1
ufila = Worksheets("hoja2").Range("A" & Rows.Count).End(xlUp).Row + 1
Worksheets("hoja2").Range("A" & ufila).Value = "algo"
Worksheets(“hoja2”).Range("A" & ufila).value = lookupvalue
Worksheets(“hoja2”).Range("B" & ufila).value = lookupvalue1
End If
'Range("D40").Select
End Sub
‘***Fin Macro
Saludos. Dam