Foro Excel

Hola a todos, tengo un lio con esto de las macros por aquello de que soy nuevon...
Bueno el caso es que tengo que extrar de una cadena de texto solo cierta parte y compararla con otra hoja si esta parte del texto se encuentra en otra hoja pues que me arroje el codigo que tiene y listos... casi casi nadita verdad... alguien dira breve cortar y pegar... pero el asunto es que no son sino 25.000 mil registros o mas... puffff...
los datos los tengo asi..

hoja1.... columna A cadena de caracteres a buscar "en esta cadena puede estar algo asi como: Institucion superior de desarrollo agricola sede los almendros" (Con minusculas y todo..)

hoja Instituciones "de hecho se llama Instituciones" en la columna A tengo: Codigo Institucion... 12345...
Columna B tengo: Nombre de la institucion.... Institucion Superior de Desarrollo Agricola (Con mayusculas y todo)
Columna C tengo: Codigo Sede... 1234501
Columna D tengo: Nombre Sede...Sede los Almendros (Con mayusculas y todo)....


Como les decia si asi es un problema el bravo como sera si tengo 25.000 mil o mas registros..???

por ahi me encontre un codigo que busca el dato escrito en una casilla y arroja el resultado en un sector determinado pero no logro que me busque entre hojas...

Alguien que me pueda ayudar por favor..??

Aca dejo el codigo que estoy utilizando..


Sub Buscar_Texto_En_Lista()

'dimensiones
Dim lngUltimaFila As Long
Dim strObjetoBuscar As String
Dim lngResultado As Long
Dim lngColumna As Long, lngFila As Long
Dim lngPegarColumna As Long, lngPegarFila As Long
Dim x As Integer, n As Integer

'quitar resultados anteriores
Range("G7:H10000").ClearContents

'columna + fila donde empezar/terminar búsqueda
Worksheets("INSTITUCIONES OFICIALES").Select
lngColumna = 6
lngFila = 7
lngUltimaFila = Columns(lngColumna).Range("E65536").End(xlUp).Row

'columna + fila donde empezar a pegar resultados
lngPegarColumna = 7
lngPegarFila = 5

'objeto a buscar
Worksheets("INSTITUCIONES OFICIALES").Select
strObjetoBuscar = Range("G2").Text
If strObjetoBuscar = "" Then GoTo 99
'minúsculas
strObjetoBuscar = LCase(strObjetoBuscar)

'bucle: realizar búsqueda
For n = lngFila To lngUltimaFila

'evaluación
lngResultado = InStr(1, Cells(n, 3), strObjetoBuscar, vbTextCompare)

'copiar/pegar
If lngResultado > 0 Then
Range(Cells(n, 2), Cells(n, 4)).Copy
Range( _
Cells(lngPegarFila, lngPegarColumna), _
Cells(lngPegarFila, lngPegarColumna + 2)) _
.Select
ActiveSheet.Paste
lngPegarFila = lngPegarFila + 1
End If

Next n

'aparcar
Worksheets("hoja1").Select
Application.CutCopyMode = False
Range("G2").Select

99:
End Sub

Por su colaboracion mil gracias.