Búsqueda de datos
En una hoja tengo unos datos, en 14 columnas, todas ellas tituladas a partir de A1. A través de un código realizo una búsqueda de datos dentro de esta hoja. Este código realiza una búsqueda, a partir del dato introducido en un ImputBox, y me copia en otra hoja todas las filas en las que aparece el nombre buscado, con sus correspondientes columna (13). Me gustaría realizar algunas modificaciones:
1.- Que al realizar esta búsqueda omita la columna 11; es decir, busque en toda la hoja, como ahora hace, excepto en la columna 11.
2.- Que al realizar la copia en la hoja, comience en me incluya los títulos, y comience en la celda A3, incluyendo los títulos; y, por último,
3.- En la celda M1, de esa misma hoja, me copie el dato buscado.
DÓDIGO:
Dim algunaCoincidencia As Boolean Dim Fila As Integer Dim sede As String Dim i As Integer, uFila As Integer, uColumna As Integer Dim Hoja As Worksheet Dim Rango As Range Sub BuscarSede() sede = InputBox("Introduzca el texto de busqueda") sede = "*" & sede & "*" 'Añadimos los caracteres comodin al principio y al final For Each Hoja In ThisWorkbook.Sheets If Hoja.Name <> "Hoja2" Then 'Esta es la hoja de resultados Hoja.Activate EncontrarSede Hoja End If Next If algunaCoincidencia = False Then MsgBox ("No se han encontrado coincidencias") End If End Sub Sub EncontrarSede(Hoja As Worksheet) On Error GoTo salir algunaCoincidencia = True 'Buscamos la última fila y columna de la hoja para acotar el rango uFila = Hoja.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row uColumna = Hoja.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column 'Acotamos el rango Set Rango = Range(Hoja.Cells(1, 1), Hoja.Cells(uFila, uColumna)) For Each celda In Rango 'Buscamos en todo el rango If UCase(celda.Value) Like UCase(sede) Then 'Comparamos por parecido a On Error GoTo Hoja2Vacia 'Buscamos primera fila vacía en Hoja2 Fila = Hoja2.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1 'Copiamos la fila de la Hoja en la Hoja2 Hoja.Rows(celda.Row).Copy Hoja2.Rows(Fila) 'Hemos encontrado coincidencia algunaCoincidencia = True End If Next Exit Sub '----------------------------------------------- Hoja2Vacia: Fila = 2 Resume Next salir: End Sub
Saludos.