Macro para filtrar datos y copiar y pegar en otra hoja dependiendo de la condición del filtro

El siguiente es para solicitar su apoyo en lo siguiente:

Estoy realizando una macro que filtre datos de una hoja y los pegue en otra de la siguiente manera.

En la hoja 1 tengo los datos que bajo desde el sistema, en esta hoja tengo formulas que me dan ciertas condiciones en los datos por ejemplo, en la columna J tengo: Activo, Inactivo, Averiado, Extraviado y En reparación.

Lo que quiero es que la macro vaya seleccionando cada una de las condiciones de la columna J y copie los datos de la columna C a la F y los de la columna H y los pegue en la hoja 2. Es decir: seleccione de J "Activo" y copie las columnas C a la F y la columna H y la pegue en la hoja 2 en A2, seleccione de J "Inactivo" y copie las columnas C a la F y la columna H y la pegue en la hoja 2 en A50, y así.

Traté de hacerlo con el grabador de macros, pero no se como ponerle para que seleccione el inicio y fin para copiar y tampoco supe como condicionar si por ejemplo en la columna J selecciono "Averiado" y no hay datos, continuar con la siguiente condición.

Agradecido por su atención me despido

2 respuestas

Respuesta
1
  • Si solamente ordenas la hoja1 por la columna J, tendrás los datos agrupados por tipo, solamente tendrías que copiar las columnas que necesitas a la hoja2.
  • Otra duda, qué pasa si copias los registros con tipo = "activo", y el número de registros es más de 50; entonces cuando selecciones los "inactivo", y los pegas en la A50, sobre-escribirán algunos registros de "activos".
  • ¿Tu datos de la hoja1 tienen encabezado?
  • ¿Al copiar y pegar quieres poner el encabezado en cada agrupación del tipo?

Te anexo la macro, suponiendo lo siguiente, el encabezado está en la fila 1, no vas a copiar el encabezado en cada tipo, y entre cada agrupación de tipo, va a dejar una fila vacía.


Cambian lo siguiente en la macro por tus datos:

    Set h1 = Sheets("Hoja 1")   'hoja origen
    Set h2 = Sheets("Hoja 2")   'hoja estino
    Set h3 = Sheets("temp")     'hoja temporal
    fila = 1                    'fila de encabezados

Para que funcione la macro, debes crear una hoja y le pones por nombre "temp"

Sub Filtrar_Datos_Por_Condicion()
'
' Por Dante Amor
'
    Application.ScreenUpdating = False
    Set h1 = Sheets("Hoja 1")   'hoja origen
    Set h2 = Sheets("Hoja 2")   'hoja estino
    Set h3 = Sheets("temp")     'hoja temporal
    fila = 1                    'fila de encabezados
    '
    h1.Rows(fila).Copy h2.Rows(1)
    h2.Cells.ClearContents
    h3.Cells.ClearContents
    If h1.AutoFilterMode Then h1.AutoFilterMode = False
    u1 = h1.Range("J" & Rows.Count).End(xlUp).Row
    h1.Range("J" & fila & ":J" & u1).Copy h3.Range("A1")
    u3 = h3.Range("A" & Rows.Count).End(xlUp).Row
    h3.Range("A" & fila & ":A" & u3).RemoveDuplicates Columns:=1, Header:=xlYes
    u3 = h3.Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To u3
        If h1.AutoFilterMode Then h1.AutoFilterMode = False
        u1 = h1.Range("J" & Rows.Count).End(xlUp).Row
        h1.Range("A" & fila & ":J" & u1).AutoFilter Field:=10, Criteria1:=h3.Cells(i, "A").Value
        u2 = h2.Range("A" & Rows.Count).End(xlUp).Row + 2
        h1.Range("C" & fila + 1 & ":F" & u1 & ",H" & fila + 1 & ":H" & u1).Copy
        h2.Range("A" & u2).PasteSpecial xlValues
    Next
    If h1.AutoFilterMode Then h1.AutoFilterMode = False
    Range("A1").Select
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    MsgBox "Fin"
End Sub

Nota: La columna C de la hoja1, siempre debe tener datos, si no es así, entonces debes cambiar en la macro en esta línea:

        u2 = h2.Range("A" & Rows.Count).End(xlUp).Row + 2

La letra "A" por la columna que siempre tenga datos, de acuerdo a la siguiente relación:

Si la columna "D" siempre tiene datos, entonces pones una "B".

Si "E", entonces "C"

Si "F", entonces "D"

Si "H", entonces "E"



'.[Sal u dos. Dante Amor. No olvides valorar la respuesta. 
'.[Avísame cualquier duda

Dante muchas gracias por tu colaboración. Yo estoy adaptando la macro para los requerimientos que necesito puesto que los datos que envié en la consulta, son un ejemplo. Esto me sirve para ir aprendiendo un poco más sobre el uso de los bucles.

En el caso del:

u2 = h2.Range("A" & Rows.Count).End(xlUp).Row + 2

Por lo que entiendo, este es el que me va a indicar la separación del copiado de la información:

Si es así, la pregunta es como puedo hacer para que el pegado arranque, por ejemplo, desde la celda A12 y continúe una separación de 5 filas hasta que termine el bucle?

Para ser mas específico, la información va a ir pegada en unos cuadros que tienen una separación uno del otro de 5 filas, puede que lo que filtre, tenga menos información que la cantidad de espacios que tengo en el cuadro. Ejemplo, cada cuadro tiene 10 filas, 5 filas de espacio y otro cuadro de 10 filas y así. Como hacer para que cada información pegue en cada cuadro respectivamente

Te anexo la macro para que empiece en la fila 12

Sub Filtrar_Datos_Por_Condicion()
'
' Por Dante Amor
'
    Application.ScreenUpdating = False
    Set h1 = Sheets("Hoja 1")   'hoja origen
    Set h2 = Sheets("Hoja 2")   'hoja estino
    Set h3 = Sheets("temp")     'hoja temporal
    fila = 1                    'fila de encabezados
    '
    h1.Rows(fila).Copy h2.Rows(1)
    h2.Cells.ClearContents
    h3.Cells.ClearContents
    If h1.AutoFilterMode Then h1.AutoFilterMode = False
    u1 = h1.Range("J" & Rows.Count).End(xlUp).Row
    h1.Range("J" & fila & ":J" & u1).Copy h3.Range("A1")
    u3 = h3.Range("A" & Rows.Count).End(xlUp).Row
    h3.Range("A" & fila & ":A" & u3).RemoveDuplicates Columns:=1, Header:=xlYes
    u3 = h3.Range("A" & Rows.Count).End(xlUp).Row
    pegado = 12
    For i = 2 To u3
        If h1.AutoFilterMode Then h1.AutoFilterMode = False
        u1 = h1.Range("J" & Rows.Count).End(xlUp).Row
        h1.Range("A" & fila & ":J" & u1).AutoFilter Field:=10, Criteria1:=h3.Cells(i, "A").Value
        'u2 = h2.Range("A" & Rows.Count).End(xlUp).Row + 2
        h1.Range("C" & fila + 1 & ":F" & u1 & ",H" & fila + 1 & ":H" & u1).Copy
        h2.Range("A" & pegado).PasteSpecial xlValues
        pegado = pegado + 15
    Next
    If h1.AutoFilterMode Then h1.AutoFilterMode = False
    Range("A1").Select
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    MsgBox "Fin"
End Sub


'.[Sal u dos. Dante Amor. No olvides valorar la respuesta. 

¡Muchas gracias Dante! 

Hola Dante, disculpa, estoy haciendo unas pruebas y si por ejemplo en el filtrado no está uno de los criterios, entonces pega todo mal en la hoja 2. Creo que habría que validar si el criterio se cumple y sino saltar al siguiente criterio y que pegue en el cuadro que corresponde. Me puedes ayudar a ver eso por favor?

Con mucho gusto te ayudo con todas tus peticiones.

Crea una nueva pregunta, pero debes especificar qué copiar y exactamente en dónde pegar. Puedes utilizar imágenes para ejemplificar lo que realmente quieres.

Respuesta
1

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas