Exportar registros filtrados en Excel
Tengo una planilla de registros en Excel que filtro mediante algunos textbox y combobox.
Aquellos que cumplen con las condiciones indicadas, son mostrados en un listbox.
Lo que necesito hacer ahora, es que esos registros filtrados y mostrados en el listbox, pueda copiarlos al portapapeles para pegarlos y trabajarlos en otro archivo (sea Excel o Word). ¿Cómo puedo hacer esto último?
1 Respuesta
No, mi estimado. No lo consigo.
Algo no está andando bien.
El código en su contexto quedó así:
If u2 > 1 Then
With ListBox1
.ColumnHeads = True
.ColumnCount = Columns(col).Column
.ColumnWidths = ancho
.RowSource = h2.Name & "!A2:" & col & u2
h2.Range("A1:" & col & u2).Copy
End With
End If
¿Pero qué es lo que no consigues?
El rango de la hoja está copiado, es decir lo tienes en memoria.
Qué es lo siguiente qué quieres hacer, ¿lo quieres pegar en otra hoja?
Entonces puede ser así:
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
Sheets("Hoja1").Cells.Clear
h2.Range("A1:" & col & u2).Copy Sheets("Hoja1").Range("A1")
End With
End If
If h1.AutoFilterMode Then h1.AutoFilterMode = False
Application.ScreenUpdating = True
End SubLo siguiente copia el resultado del filtro y lo pega en la hoja1 (debes crear una hoja llamada "hoja1")
Sheets("Hoja1"). Cells. Clear
H2.Range("A1:" & col & u2). Copy Sheets("Hoja1"). Range("A1")
sal u dos
¡Gracias! Eso era precisamente lo que necesitaba.
Seguiré probando tu código, pero creo que era todo lo que necesitaba.
Nuevamente, gracias y otro ciber-abrazo.-
