Consultar el listado mediante parametros

Hola Sergio,

Hasta a mi (que se supone que se por donde van los tiros) me ha resultado
dificil entender lo que buscas. De hecho no estoy seguro de q te haya
entendido bien. Suponiendo que te refieres al codigo con llamadas ADO q te
habia escrito antes, aqui te pongo una opcion como cambiar las variables
dinamicamente.

En la hoja donde se tienen que mostrar los resultados de la consulta haz lo
siguiente:

1) en la fila [4] pon los encabezados de columnas exactamente como aparecen
en las hojas de donde se sacaran los datos
2) en la fila [1] selecciona todas las celdas que estan por encima de los
encabezados, ve al menu Datos>Validacion, opcion Lista y en vez de formula
pon: LIKE; =; <=; >=; <; >; <>
Estos no son todos los operadores posibles asi que tendras campo para
perfeccionar tu proyecto.
3) en la celda [A3] pon la siguiente formula y copiala a todas las celdas
que estan por encima de los encabezados:
=SI(O(A2="";A1="");"";SI(O(ESTEXTO(A2);A1="LIKE");"'"&A2&"'";SI(A2="";"";A2)))
4) Protege las filas [3] y [4]

Ahora en la fila [1] podras seleccionar el operador de comparacion (LIKE; =;
<=; >=; <; >; <>), en la fila [2] pondras el criterio de comparacion (p.ej.
un valor o cadena de texto), en la fila [3] tu criterio se representara con
sintaxis SQL y en la fila [4] estara el nombre del campo para el cual as
puesto el criterio. Tal como lo he diseñado, los criterios solo se juntaran
con el operador AND, o sea que cada filtro se aplicara sobre el filtro
anterior. Si, por ejemplo, quieres sacar los registros que tienen en el
campo MES el valor Febrero o Marzo tendras q hacer dos consultas seguidas
con cada uno de los criterios.

Abajo te pongo el codigo modificado (acuerdate de cambiar el valor de la
variable Hoja).

Si quieres q te mande una hoja de muestra dimelo.

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 = "Hoja1"

With ThisWorkbook.Worksheets(1)
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(1)
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