Te anexo la macro actualizada
Private Sub Resultados_Click()
'Por Dante Amor
'Aplicar Filtros(fechas, combos y textbox)
'
Set h1 = Sheets("Consultas")
Set h2 = Sheets("Estadisticas")
'
If ComboBox1.ListIndex > 0 Then
If ComboBox2.Value = "" Or Not IsDate(ComboBox2.Value) Then
MsgBox "Captura una fecha válida"
ComboBox2.SetFocus
Exit Sub
End If
fec1 = Format(CDate(ComboBox2.Value), "mm/dd/yyyy")
fec2 = fec1
End If
'
Select Case ComboBox1.ListIndex
Case 0, -1
crit1 = ">=": crit2 = ">="
fec1 = "01/01/1900"
fec2 = fec1
Case 1 'después de
crit1 = ">=": crit2 = ">="
Case 2 'antes de
crit1 = "<=": crit2 = "<="
Case 3 'entre
crit1 = ">=": crit2 = "<="
If ComboBox3.Value = "" Or Not IsDate(ComboBox3.Value) Then
MsgBox "Captura una fecha válida"
ComboBox3.SetFocus
Exit Sub
End If
If CDate(ComboBox3.Value) < CDate(ComboBox2.Value) Then
MsgBox "La fecha <HASTA> es anterior a la fecha <DESDE>" & vbNewLine & vbNewLine & "Por favor, corrija este error", vbCritical
Exit Sub
End If
fec2 = Format(CDate(ComboBox3.Value), "mm/dd/yyyy")
End Select
'
Application.ScreenUpdating = False
h2.Range("2:" & Rows.Count).ClearContents
If h1.AutoFilterMode Then h1.AutoFilterMode = False
u1 = h1.Range("A" & Rows.Count).End(xlUp).Row
With h1.Sort
.SortFields.Clear
.SortFields.Add Key:=h1.Range("A2:A" & u1), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
.SetRange h1.Range("A1:Q" & u1): .Header = xlYes: .MatchCase = False: _
.Orientation = xlTopToBottom: .SortMethod = xlPinYin: .Apply
End With
'
'Filtros
With h1.Range("A1:Q" & u1)
.AutoFilter Field:=1, Criteria1:=crit1 & fec1, Operator:=xlAnd, Criteria2:=crit2 & fec2
.AutoFilter Field:=2, Criteria1:="*" & Me.Asesor.Value & "*" 'Asesor
.AutoFilter Field:=3, Criteria1:="*" & Me.ComboBox4.Value 'Modalidad
.AutoFilter Field:=4, Criteria1:="*" & Me.ComboBox5.Value 'Actividad
.AutoFilter Field:=5, Criteria1:="*" & Me.Tema.Value & "*" 'tema
End With
'
col = "Q"
u1 = h1.Range("A" & Rows.Count).End(xlUp).Row
If u1 > 1 Then
h1.Range("A2:" & col & u1).Copy h2.Range("A2")
End If
h2.Cells.EntireColumn.AutoFit
For i = 1 To Columns(col).Column
ancho = ancho & Int(h2.Cells(1, i).Width + 3) & "; "
Next
'
u2 = h2.Range("A" & Rows.Count).End(xlUp).Row
If u2 > 1 Then
With ListBox1
.ColumnHeads = True
.ColumnCount = Columns(col).Column
.ColumnWidths = ancho
.RowSource = h2.Name & "!A2:" & col & u2
End With
End If
If h1.AutoFilterMode Then h1.AutoFilterMode = False
Application.ScreenUpdating = True
End Sub
Con mucho gusto te ayudo con todas tus peticiones.
Valora esta respuesta y crea una nueva pregunta