Macro que busque un dato en otra hoja y copie de esa fila el dato de una columna especifica incluyendo formato de celda
Tengo una hoja llamada "CLIENTES" y otra hoja llamada "CARTERA". Deseo una macro que al ejecutarla en la hoja "CLIENTES" me busque el dato que esta ubicado en la columna "C" de la hoja clientes en donde este parado el cursor en ese momento y busque ese dato en la hoja CARTERA en la columna C pero en sentido de abajo hacia arriba (en ese sentido) y cuando encuentre el primer dato que coincida de abajo hacia arriba, se ubique en la columna AZ de esa fila y copie su contenido (incluyendo valor y formato de celda es decir sombreado, color de letra, negrilla, etc) y eso lo copie tal cual en la columna I de la hoja CLIENTES de la fila en donde comenzó la macro.
Ejemplo:
Estoy en la hoja CLIENTES y Ubico el cursor en cualquier celda de una fila POR (solo por poner un ejemplo supongamos que estoy ubicado en la celda FX). Ejecuto la macro y el va y busca el valor que esta en la columna C de la fila POR de la hoja clientes. Ese valor va y lo busca en la hoja CARTERA en la columna C pero NO DE ARRIBA HACIA ABAJO sino DE ABAJO HACIA ARRIBA (sentido inverso) y una vez lo encuentra (supongamos que lo encuentra en la fila Y) entonces se ubica en la columna AZ de la fila Y de la hoja CARTERA y copia todo su contenido incluyendo formato de celda, color de letra, negrilla etc. Y eso va y lo pega en la hoja CLIENTES, fila POR columna I, una vez termina de hacer eso la macro pregunta si desea terminar la macro (fin de la macro) o si desea subir una fila (osea para este ejemplo seria ahora ejecutar la macro para la fila anterior a donde estamos es decir F(X-1) de esa manera si la macro cada vez que termine de copiar el dato le diéramos esa opción continuaría ejecutando la macro con la fila anterior correspondiente en ese momento.
1 Respuesta
Prueba lo siguiente:
Sub Buscar_Dato()
Dim f As Range, res As Variant, sh As Worksheet
'
If UCase(ActiveSheet.Name) <> "CLIENTES" Then
MsgBox "Seleciona la hoja clientes"
Exit Sub
End If
If ActiveCell.Column <> 3 Then
MsgBox "Selecciona una celda de la columna C"
Exit Sub
End If
'
Set sh = Sheets("CARTERA")
Do While True
If ActiveCell.Value = "" Then
MsgBox "Celda vacía"
Exit Do
End If
Set f = sh.Range("C:C").Find(ActiveCell.Value, , xlValues, xlWhole, , xlPrevious)
If Not f Is Nothing Then
sh.Cells(f.Row, "AZ").Copy Cells(ActiveCell.Row, "I")
res = MsgBox("Dato actualizado." & vbCr & "Desea terminar la macro", vbQuestion + vbYesNo)
If res = vbYes Then Exit Do
If ActiveCell.Row = 1 Then
MsgBox "No hay más filas anteriores"
Exit Do
Else
ActiveCell.Offset(-1).Select
End If
Else
MsgBox "El dato no existe"
Exit Do
End If
Loop
End Sub
