Macro Filtrar + Copiar
Hola.
Necesitaba hacer una macro que de un listado de registros con los campos (Mes, Factura, Fecha, Nombre, Importe, Indicador y Exento) filtrara por Indicador = R0 y Exento = EX.
El resultado tendría que copiarlo en otra pestaña y añadir una primera columna al listado con el nombre de la sociedad.
¿Podéis ayudarme?
Gracias.
Necesitaba hacer una macro que de un listado de registros con los campos (Mes, Factura, Fecha, Nombre, Importe, Indicador y Exento) filtrara por Indicador = R0 y Exento = EX.
El resultado tendría que copiarlo en otra pestaña y añadir una primera columna al listado con el nombre de la sociedad.
¿Podéis ayudarme?
Gracias.
1 Respuesta
Respuesta de Elsa Matilde
1
Te adjunto 2 rutinas que podrás adaptar a tus referencias (encontrarás comentarios en las macros)
Ambas deben ser copiadas en un módulo.
Sub Filtro2()
Dim miHoja As String, crit1 As String, crit2 As String
'definir la hoja que se filtrará
miHoja = "Filtro"
'los criterios se buscan en otra hoja o se est
crit1 = "RO"
crit2 = "EX"
'seleccionar una celda de la base a filtrar
On Error GoTo NoHoja
Sheets(miHoja).Select
ActiveSheet.Range("A1").Select
'se establece Autofiltro
Selection.AutoFilter
'se filtra la columna 6 y 7 por los criterios guardados
Selection.AutoFilter Field:=6, Criteria1:=crit1
Selection.AutoFilter Field:=7, Criteria1:=crit2
'se ejecuta la rutina de copiado
Application.Run "CopiaCeldasFilt"
Exit Sub
NoHoja:
MsgBox "No se encuentra la hoja buscada"
End Sub
Sub CopiaCeldasFilt()
'Indicar una celda de la base filtrada:
Dim UnaCelda
UnaCelda = "A1"
'Copiado de celdas visibles
Range(UnaCelda).CurrentRegion.SpecialCells(xlCellTypeVisible).Copy
' Establecer libro, hoja y rango de destino
Sheets("Hoja5").Activate
Range("B1").Select
'pegado de valores
Selection.PasteSpecial Paste:=xlValues
'Pegado de formatos
Selection.PasteSpecial Paste:=xlFormats
End Sub
Saludos y no olvides finalizar la consulta
Elsa
** Estas rutinas fueron extraídas de mi manual '400Macros' .... Descarga demo desde:
Ambas deben ser copiadas en un módulo.
Sub Filtro2()
Dim miHoja As String, crit1 As String, crit2 As String
'definir la hoja que se filtrará
miHoja = "Filtro"
'los criterios se buscan en otra hoja o se est
crit1 = "RO"
crit2 = "EX"
'seleccionar una celda de la base a filtrar
On Error GoTo NoHoja
Sheets(miHoja).Select
ActiveSheet.Range("A1").Select
'se establece Autofiltro
Selection.AutoFilter
'se filtra la columna 6 y 7 por los criterios guardados
Selection.AutoFilter Field:=6, Criteria1:=crit1
Selection.AutoFilter Field:=7, Criteria1:=crit2
'se ejecuta la rutina de copiado
Application.Run "CopiaCeldasFilt"
Exit Sub
NoHoja:
MsgBox "No se encuentra la hoja buscada"
End Sub
Sub CopiaCeldasFilt()
'Indicar una celda de la base filtrada:
Dim UnaCelda
UnaCelda = "A1"
'Copiado de celdas visibles
Range(UnaCelda).CurrentRegion.SpecialCells(xlCellTypeVisible).Copy
' Establecer libro, hoja y rango de destino
Sheets("Hoja5").Activate
Range("B1").Select
'pegado de valores
Selection.PasteSpecial Paste:=xlValues
'Pegado de formatos
Selection.PasteSpecial Paste:=xlFormats
End Sub
Saludos y no olvides finalizar la consulta
Elsa
** Estas rutinas fueron extraídas de mi manual '400Macros' .... Descarga demo desde:
