Consulta a datos de un mismo libro

Hola Sergio,

Creo q la solucion que te di en mi penultimo posting te vale para lo que
describes. Suponiendo que tienes los datos en la hoja "Datos", crea otra
hoja, digamos "Consulta", y crea alli las filas con criterios tal como te
habia explicado antes. Usa el siguiente codigo (cuando aparezca el dialogo
selecciona el mismo fichero en el cual estas trabajando) - solo he cambiado
los nombres de hojas.

Saludos,
KL

'Inicio Codigo
Sub GetWorksheetData(strSourceFile As String, _
strSQL As String, TargetCell As Range)
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim f As Integer, r As Long

If TargetCell Is Nothing Then Exit Sub
Set cn = New ADODB.Connection

On Error Resume Next
cn.Open "DRIVER={Microsoft Excel Driver (*.xls)};" & _
"DriverIdy0;ReadOnly=True;DBQ=" & strSourceFile & ";"

On Error GoTo 0
If cn Is Nothing Then
MsgBox "Can't find the file!", _
vbExclamation, ThisWorkbook.Name
Exit Sub
End If

' open a recordset
Set rs = New ADODB.Recordset
On Error Resume Next
rs.Open strSQL, cn, adOpenForwardOnly, _
adLockReadOnly, adCmdText

On Error GoTo 0
If rs Is Nothing Then
MsgBox "Can't open the file!", _
vbExclamation, ThisWorkbook.Name
cn.Close
Set cn = Nothing
Exit Sub
End If

TargetCell.CopyFromRecordset rs

If rs.State = adStateOpen Then
rs.Close
End If
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub

Sub ExtraerDatos()
Dim Archivo As String, Hoja As String, BD As Variant
Dim CondStr As String

BD = Application.GetOpenFilename _
("Archivos Microsoft Excel (*.xls), *.xls", , _
"Seleccionar las Bases de Datos", , True)

Hoja = "Datos"

With ThisWorkbook.Worksheets("Consulta")
UCol = .Cells(3, Columns.Count).End(xlToLeft).Column
For i = 1 To UCol
If .Cells(3, i) <> "" Then
If StrTemp <> "" Then StrTemp = StrTemp & " AND "
StrTemp = StrTemp & "[" & .Cells(4, i) & "] " & .Cells(1, i)
_
& " " & .Cells(3, i)
End If
Next i
If StrTemp <> "" Then
CondStr = " WHERE " & StrTemp
Else
CondStr = StrTemp
End If
End With

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.StatusBar = "Writing data from recordset..."
End With
On Error GoTo ManejoErrores
For i = LBound(BD) To UBound(BD)
On Error GoTo 0
With ThisWorkbook.Worksheets("Consulta")
UFila = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
Archivo = BD(i)

GetWorksheetData Archivo, _
"SELECT * FROM [" & Hoja & "$]" & _
CondStr, .Cells(UFila, 1)
End With
Next i
With Application
.StatusBar = False
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
Exit Sub

ManejoErrores:
With Application
.StatusBar = False
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
MsgBox "La operacion se ha cancelado."
Exit Sub
End Sub
'Fin Codigo