Macro que busque valores de una hoja en otra y anote fecha determinada
Tengo una lista de números en hoja "Pendientes" en columna C. Su número de registros varía (filas). Tengo también una lista de números en hoja "Aceptados" en la columna A. Su numero de registros también puede ser variable. Junto a estos en columna B tengo una fecha. Solicito me ayuden para hacer lo siguiente:
Tomar el primer registro de hoja "Aceptados" en A1, buscarlo en hoja "Pendientes" en columna C. Cuando lo encuentre tomar el registro de fecha en hoja "Aceptados" en B1, y poner esta fecha en hoja "Pendientes" en la fila que corresponda al registro encontrado pero en la columna F. Si no lo encuentra lanzar un mensaje, aceptarlo y continuar con A2 de la hoja de Aceptados. Finalizar cuando haya hecho lo mismo con todos los registros de "Aceptados" columna A.
Esta macro es muy difícil para mi y os agradecería vuestra ayuda.
1 Respuesta
Ejecuta la siguiente macro en la hoja "Aceptados"
Sub BusarValores()
'Por.Dante Amor
Set h1 = Sheets("Aceptados")
Set h2 = Sheets("Pendientes")
'
For i = 1 To h1.Range("A" & Rows.Count).End(xlUp).Row
Set b = h2.Columns("C").Find(h1.Cells(i, "A"), lookat:=xlWhole, LookIn:=xlFormulas)
If Not b Is Nothing Then
h2.Cells(b.Row, "F") = h1.Cells(i, "B")
Else
MsgBox "El número " & h1.Cells(i, "A") & " No fue encontrado", vbExclamation
End If
Next
End SubSaludos.Dante Amor
Dante, es estupendo, funciona perfecta, quisiera pedirte a ver si fuera posible una ampliación, es lo siguiente: Al terminar la ejecución podría salir otro mensaje indicando "Proceso concluido, pulse aceptar" y al pulsarlo que se posicione en la última fecha puesta en la columna F de Pendientes.
Mi valoración ya es excelente Dante, muchas gracias, luego te valoro.
Te anexo la macro
Sub BusarValores()
'Por.Dante Amor
Set h1 = Sheets("Aceptados")
Set h2 = Sheets("Pendientes")
'
ult = 1
For i = 1 To h1.Range("A" & Rows.Count).End(xlUp).Row
Set b = h2.Columns("C").Find(h1.Cells(i, "A"), lookat:=xlWhole, LookIn:=xlFormulas)
If Not b Is Nothing Then
h2.Cells(b.Row, "F") = h1.Cells(i, "B")
ult = b.Row
Else
MsgBox "El número " & h1.Cells(i, "A") & " No fue encontrado", vbExclamation
End If
Next
MsgBox "Proceso concluido, pulse Aceptar", vbInformation
h2.Select
h2.Cells(ult, "F").Select
End Sub
Estimado Dante, se me para con error de compilación "no se ha definido Sub o Function" en el nuevo
MsgBox "Proceso concluido, pulse Aceptar", vbInformation
Sabes qué puede faltarle¿?
La macro funciona bien, revisa que la hayas copiado bien. Vuelve a copiarla
Saludos
No olvides valorar la respuesta, la macro original funciona bien desde el principio.
