Macro para copiar contenido de una celda a otra que contenga una palabra en espesifico
Tengo en la columna "A" el nombres completos de personas, necesito un macro que me devuelva en la columna "B" todas las personas llamadas "Luis" . Adjunto una imagen de ejemplo.
1 Respuesta
Respuesta de James Bond
1
Prueba con esta macro
Sub buscar_palabra()
Set DATOS = Range("a1").CurrentRegion
PALABRA = UCase(InputBox("TECLEA UN NOMBRE A COPIAR"))
If PALABRA = Empty Then End
With DATOS
FILAS = .Rows.Count
For I = 1 To FILAS
NOMBRE = UCase(.Cells(I, 1))
On Error Resume Next
.Cells(I, 2) = WorksheetFunction.Find(PALABRA, NOMBRE, 1)
On Error GoTo 0
Next I
Set DATOS = .CurrentRegion
.Sort KEY1:=Range(.Columns(2).Address), ORDER1:=xlAscending
CUENTA = WorksheetFunction.CountIf(.Columns(2), ">0")
.Columns(2).Clear
.Resize(CUENTA, 1).Copy: Range("B1").PasteSpecial xlPasteValues
.CurrentRegion.EntireColumn.AutoFit
End With
End Sub
Tiene el inconveniente de desordenar la columna "A" y es importante conservar el orden de los elementos de la columna "A".
PD: los elementos de la columna "A" esta ordenados por una orden de llegada por decirlo así, así que no conservan un orden alfabético, por lo que si desordenan se malogra el trabajo anterior.
Si no es mucha molestia, deseo poner el nombre a buscar en la línea de comandos, no por inbox
Entonces prueba con esta macro
Sub buscar_datos()
Set datos = Range("a1").CurrentRegion
nombre = "luis"
With datos
filas = .Rows.Count
x = 1
For i = 1 To filas
cnombre = .Cells(i, 1)
On Error Resume Next
nom = WorksheetFunction.Find(UCase(nombre), UCase(cnombre), 1)
If Err = 0 Then .Cells(x, 2) = .Cells(i, 1): x = x + 1
On Error GoTo 0
Next i
End With
End Sub
