Continuación Filtrar Datos y pegar en otra Hoja

Como estas Dante. La última respuesta que recibi de la pregunta anterior, fue esta

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

Esto me funciona perfectamente si en la hoja 1, los criterios a filtrar están todos, pero cuando uno de los criterios falta no se pegan bien los datos. Fíjate, voy a hacer el planteamiento de la siguiente manera:

Tengo una hoja llamada "Hoja 1" en la que pego los datos que bajan del sistema de la siguiente manera:

Quiero filtrar, de acuerdo al criterio de J y pegar en la hoja 2 que está de la siguiente manera:

En tu macro, yo modifique lo que indicas como hoja temporal y coloqué base de datos, donde tengo varias datos que son constantes en el archivo y seleccioné la columna B en lo que corresponde a la busqueda del criterio.

Ahí es el por qué a mi me da error en el caso de que no exista en la hoja uno el criterio que está buscando. En tu macro validabas esa información al copiar los datos en Temp. Sin embargo, en la hoja 2 siempre voy a tener los cuadros de esa manera necesitaba que la busqueda del criterio lo hiciera en una base de datos fija.

Estos cuadros los uso a manera de ejemplo y es básicamente lo que hago en el original, con mas detalles, pero eso no afecta en la macro que haga si hago los cambios correspondientes.

En la información que bajo del sistema, puede que salgan todos los criterios, o puede que falte uno de ellos, de igual manera quiero que lo busque y los pegue en el cuadro correspondiente los que si estén en la hoja 1

Atento a sus comentarios, me despido.

1 respuesta

Respuesta
1

Te anexo la macro actualizada

Sub Filtrar_Datos_Por_Condicion()
'
' Por Dante Amor
'
    Application.ScreenUpdating = False
    Set h1 = Sheets("Hoja1")            'hoja origen
    Set h2 = Sheets("Hoja2")            'hoja estino
    Set h3 = Sheets("Base de Datos")    'hoja con criterios
    fila = 3                            'fila de encabezados
    pegado = 12                         'fila inicial de pegado
    '
    If h1.AutoFilterMode Then h1.AutoFilterMode = False
    For i = 2 To h3.Range("B" & Rows.Count).End(xlUp).Row
        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, "B").Value
        u1 = h1.Range("J" & Rows.Count).End(xlUp).Row
        If u1 > fila Then
            h1.Range("C" & fila + 1 & ":F" & u1 & ",H" & fila + 1 & ":H" & u1).Copy
            h2.Range("A" & pegado).PasteSpecial xlValues
        End If
        pegado = pegado + 15
    Next
    If h1.AutoFilterMode Then h1.AutoFilterMode = False
    h2.Select
    Range("A1").Select
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    MsgBox "Fin"
End Sub

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

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas