jueves, 22 de enero de 2015

VBA: Copiar datos filtrados/visibles de una Tabla.

Veremos hoy un trabajo doble interesante:
Primero veremos cómo aplicar un filtro de fechas con macros sobre una Tabla (problemático habitualmente por una incompatibilidad de la configuración regional)
Segundo cómo copiar y pegar el resultado del filtro aplicado.


Partiremos de la siguiente hoja:

VBA: Copiar datos filtrados/visibles de una Tabla.



El trabajo del siguiente procedimiento consiste primero en aplicar un Filtro de fechas sobre el campo 'Fecha'; para ello deberemos tener la precaución de definir las variables con el tipo Long.
El motivo es salvar la configuración regional enfrentada de nuestra hoja de cálculo (dd/mm/aaaa) y la de VBA (mm/dd/yyyy)... al definirlo como Long (número entero), tratamos la fecha como lo que es para Excel, un número entero (en cualquier configuración regional, un número es un número...).


Una vez conseguido y aplicado el filtro, seleccionaremos sólo las celdas visible empleando el método SpecialCells(xlCellTypeVisible), a partir del cuerpo de la Tabla con la propiedad .DataBodyRange

Insertamos y ejecutamos el siguiente procedimiento, asignado al botón 'EXTRAER':

Sub RangoFecha()
'definimos las variables como Long para poder aplicar el autofiltro
'unica forma de salvar el problema de la configuración regional
Dim FechaDesde As Long, FechaHasta As Long
'definimos variables para aplicar el filtro sobre la tabla
FechaDesde = CDate(Range("B1").Value)
FechaHasta = CDate(Range("B2").Value)

'aplciamos el autofiltro sobre nuestro Tabla
ActiveSheet.ListObjects("TblDatos").Range.AutoFilter _
    Field:=1, Criteria1:=">=" & FechaDesde, Operator:=xlAnd, Criteria2:="<=" & FechaHasta

'aplciamos el copiado del resultado
Dim rng As Range

'trabajamos sólo sobre el cuerpo de la Tabla (.DataBodyRange)
'no sobre cabecera o fila totales
With ActiveSheet.ListObjects("TblDatos").DataBodyRange
    'definimos el rango visible
    'depurando el error por si no hubiera nada filtrado
    On Error Resume Next
    Set rng = .Resize(.Rows.Count, .Columns.Count).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
End With

'controlamos el fallo..
If rng Is Nothing Then
    'si no hubiera nada como resultado del filtro
    MsgBox "Sin datos a copiar"
Else
    'en caso hubiera algún dato
    MsgBox rng.Address                      'mostramos el rango de celdas..
    rng.Copy Destination:=Range("C23")      'copiamos el rango y lo pegamos a partir de C23
    Application.CutCopyMode = False         'liberamos el Portapapeles
End If

'finalizamos quitando el filtro aplicado
ActiveSheet.ListObjects("TblDatos").Range.AutoFilter Field:=1

End Sub

El resultado tras la ejecución de la macro es el siguiente... Tras aplicar el filtro vemos el Cuadro de mensaje que muestra el rango de celdas visibles dentro del cuerpo de la Tabla

VBA: Copiar datos filtrados/visibles de una Tabla.

Y se continuamos la ejecución veremos el copiado y pegado de estos datos:

VBA: Copiar datos filtrados/visibles de una Tabla.

7 comentarios:

  1. Buenas tardes.

    En primer lugar enhorabuena por el blog.
    He intentado poner en práctica esta macro, pero me copia toda la tabla, no me aplica el filtro de las fechas.
    No se que estoy haciendo mal, por lo que agradezco tu ayuda.
    A continuación te indico lo que pongo exactamente:

    Sub RangoFecha()


    Dim FechaDesde As Long, FechaHasta As Long

    FechaDesde = CDate(Range("CU2").Value)
    FechaHasta = CDate(Range("CU3").Value)


    ActiveSheet.ListObjects("Tabla13").Range.AutoFilter _
    Field:=1, Criteria1:=">=" & FechaDesde, Operator:=xlAnd, Criteria2:="<=" & FechaHasta


    Dim rng As Range



    With ActiveSheet.ListObjects("Tabla13").DataBodyRange


    On Error Resume Next
    Set rng = .Resize(.Rows.Count, .Columns.Count).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    End With


    If rng Is Nothing Then

    MsgBox "Sin datos a copiar"
    Else

    MsgBox rng.Address
    rng.Copy Destination:=Range("CZ4")
    Application.CutCopyMode = False
    End If


    ActiveSheet.ListObjects("Tabla13").Range.AutoFilter Field:=1

    End Sub


    Un saludo

    ResponderEliminar
    Respuestas
    1. Hola Diego,
      trabajar con fechas es siempre complicado y tedioso...
      Prueba cambiando esta parte
      FechaDesde = CDate(Range("CU2").Value)
      FechaHasta = CDate(Range("CU3").Value)
      por esta
      FechaDesde = CLng(Range("CU2").Value)
      FechaHasta = CLng(Range("CU3").Value)

      quizá así sí te funcione...
      Saludos

      Eliminar
  2. Hola Ismael,
    Muchas gracias por tu respuesta.
    Apliqué el cambio que me propones, y la primera vez que ejecuté la macro me funcionó, pero al cambiar de fecha, me salta un error "13" en tiempo de ejecución: no coinciden los tipos.

    Te agradezco la ayuda.

    Un saludo

    ResponderEliminar
  3. Hola otra vez,
    He comprobado una cosa:
    En la celda CU2 no tengo escrita la fecha, sino que tengo escrito =AB12 Esto es porque la fecha desde es variable. En este caso es cuando me salta el error.
    Para que no sea así, tengo que escribir la fecha manualmente.
    ¿Cómo puedo resolverlo?

    Un saludo

    ResponderEliminar
    Respuestas
    1. Hola...
      toma la variable directamente desde AB12 y no de CU3
      ;-)
      Saludos

      Eliminar
  4. Hola,
    Gracias por la respuesta. En la celda AB12 tengo una fórmula que es un SI anidado, por lo que esa solución no me sirve.
    Un saludo

    ResponderEliminar
    Respuestas
    1. Hola Diego,
      que la fecha venga de una fórmula o esté introducida sin más no influye (no debe) a la hora de trabajar sobre ella... la solución de trabajar con Clong suele ser suficiente.
      Asegúrate que está bien escrita y que es una fecha en la celda (que no es un texto que parece fecha), quizá al venir de una fórmula anterior esté perdiendo esa propiedad...
      La señal que no es problema de la programación es que cuando la escribes manualmente sí la reconoce.
      Slds

      Eliminar