Fórmula VBA Buscarv y poner datos
Siguiendo la pregunta del otro día casi lo he resuelto pero me da los siguientes errores:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("c5:c100")) Is Nothing Then
a = ActiveCell.Address
Range(a).Copy
Range("K3").PasteSpecial xlPasteValues
Application.CutCopyMode = False
Exit Sub
Con este código pretendo copiar lo que escriba en una celda de la columna "C" en la celda "K3" para usarla como valor que busco, pero se me queda como si pusiera "K3.select" y no me deja escribir nada en la columna "c"
If Not Intersect(Target, Range("D5:D100")) Is Nothing Then
'Definimos variables
Dim lookupvalue As Variant, value As Variant, lookupRange As Range
value = Range("K3").value 'celda con el valor que buscamos
Set lookupRange = Range("C5:C100") 'rango donde buscar
'Queremos la columna 4
lookupvalue = Application.VLookup(value, lookupRange, 4, False)
'Si no encuentra valor finaliza
If IsError(lookupvalue) Then
Exit Sub
'Si lo encuentra lo devuelve
Else
B = ActiveCell.Address
Range(B) = lookupvalue
Este no funciona, no hace nada, el siguiente lo que me hace es borrarlo todo y poner "0"
If Not Intersect(Target, Range("D5:D100")) Is Nothing Then
fin = Application.CountA(Worksheets("PROVA").Range("A:A"))
With Worksheets("PROVA").Range("D5:D" & fin)
.Formula = "=IF(ISERROR(VLOOKUP(K3,PROVA!$C$5:$D100" & ",2,0)),"""",VLOOKUP(K3,PROVA!$C$5:$D100" & ",2,0))"
.Formula = .value
End With
Todo son pruebas para conseguir una macro que me busque el nombre y me ponga el dni si ya existe en la hoja
2 Respuestas
Ya lo he resuelto, he encontrado este código en una página lo he adaptado y me funciona perfectamente
If Target.Column = 4 Then [K3] = Cells(Target.Row, 3)
Te propongo el siguiente código, es para buscar en la misma columna C, omitiendo la celda donde pusiste el DNI
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, c As Range, f As Range, rng2 As Range
Set rng = Intersect(Target, Range("C5:C" & Rows.Count))
If Not rng Is Nothing Then
For Each c In rng
Set rng2 = Range("C4:C" & c.Row - 1 & ", C" & c.Row + 1 & ":C" & Rows.Count)
Set f = rng2.Find(c, , xlValues, xlWhole, , , False)
If Not f Is Nothing Then
c.Offset(, 1).Value = f.Offset(, 1).Value
End If
Next
End If
End Sub[No olvides valorar las respuestas.