Macro para filtrar en una hoja y copiar en otra
Estoy programando una hoja de Excel con varias funciones y una de ellas se me ha atragantado.
Necesitaría un macro que al pulsar el botón "Consultar" enviara un cuadro de diálogo en el que se pudiera introducir el texto a buscar, buscara en la Hoja 3 este texto y copiara en la Hoja 2 todas las filas en las que se contenga ese texto.
2 Respuestas
Aquí te dejo otro tipo de macro, que te envía un cuadro de diálogo para introducir el dato a buscar y que en lugar de recorrer toda la hoja la filtra, y el resultado lo copia en tu hoja2.
Sub consulta()
'x Elsamatilde
'cuadro de diálogo para introducir el texto a buscar
dato = InputBox("Introduzca el dato a buscar")
If dato = "" Then Exit Sub
'se declara la hoja destino
Set destino = Sheets("Hoja2")
'se borran datos de filtros anteriores
destino.Range("A:D").ClearContents '.... AJUSTAR RANGO
'se asume que el texto se busca en col B .... AJUSTAR
Sheets("Hoja3").Select
'si la hoja no tiene aplicados los filtros se los coloca
If ActiveSheet.AutoFilterMode = False Then
Range("B1").AutoFilter
'si la hoja está filtrada mostrará todas las filas previamente
ElseIf ActiveSheet.FilterMode = True Then
ActiveSheet.ShowAllData
End If
'AJUSTAR RANGO DE BÚSQUEDA Y COL
ActiveSheet.Range("$A$1:$D$" & Range("A" & Rows.Count).End(xlUp).Row).AutoFilter Field:=2, Criteria1:=dato
'se copia el rango resultante a la hoja destino, con título.
fini = Range("B" & Rows.Count).End(xlUp).Row
If fini = 1 Then
MsgBox "NO hay datos para pasar."
Else
Range("A1:D" & fini).Copy Destination:=destino.[A1]
End If
'se quita el modo de filtrado de hoja origen
ActiveSheet.ShowAllData
'opcional: pasar a la hoja destino
destino.Activate
ActiveSheet.[A1].Select
End SubAjustá todas las referencias de rangos según tu modelo.
Sdos y si el tema queda resuelto no olvides valorar esta respuesta para darla por cerrada.
valor = Range("b3").Value
CONTAR = 10 'empiesa en la celda 10
For j = 1 To final
If Hoja4.Cells(j, 1) = valor Then
Sheets("informe").Cells(CONTAR, 1) = Hoja4.Cells(j, 6)
Sheets("informe").Cells(CONTAR, 2) = Hoja4.Cells(j, 4)
Sheets("informe").Cells(CONTAR, 3) = Hoja4.Cells(j, 5)
Sheets("informe").Cells(CONTAR, 4) = 1 * Hoja4.Cells(j, 3)
CONTAR = CONTAR + 1
End If
Next
informe = a tu hoja donde quiere copiar
hoja4 = a tu hoja donde se va a buscar los datos
1 = es la columna donde va a buscar el datos
contar = a la fila
contar = contar + 1 = fila despues de copiar
saludos no olvide valorar para cerrar la pregunta
End Sub