Macro que muestre información según validación de listas dependientes

Estimada Elsa:

Quisiera adaptar una macro que haga las veces como un filtro avanzado.

Tengo un libro con dos hojas. La primera llamada BD y la segunda PARA.

En la hoja PARA tengo 3 validaciones con lista dependientes.

Foto 1 - Hoja BD (Es mi base de datos)

Foto 2 - Hoja PARA

Lo que debe realizar la macro es extraer la información de la hoja BD y copiarlos a la hoja PARA de acuerdo a los valores que se le indique en lista que puede variar.

Vengo adaptando un código que me ayudaron en este foro para otro archivo que si corre, pero me parece no logro adaptarlo para este caso.

Si hay otra forma más funcional seria genial.

Quería hacerlo con esta programación, pero no ejecuta.

Favor ayuda.

Sub Lista()
Application.ScreenUpdating = False
    Set h1 = Sheets("BD")
    Set h2 = Sheets("PA")
    '
    u = h2.Range("A" & Rows.Count).End(xlUp).Row
    If u < 12 Then u = 12
    h2.Range("A12:O" & u).ClearContents
    '
    If h2.[F3] = "" Then
        MsgBox "Falta el nombre del segmento", vbExclamation, "PA"
        Exit Sub
    End If
    If h2.[F4] = "" Then
        MsgBox "Falta la División", vbExclamation, "PA"
        Exit Sub
    If h2.[F5] = "" Then
        MsgBox "Falta el Contrato", vbExclamation, "PA"
        Exit Sub
    End If
    '
    u = h1.Range("B" & Rows.Count).End(xlUp).Row
    h1.Range("A11:O" & u).AutoFilter Field:=2, Criteria1:=h2.[F3]
    h1.Range("A11:O" & u).AutoFilter Field:=3, Criteria1:=h2.[F4]
    h1.Range("A11:O" & u).AutoFilter Field:=4, Criteria1:=h2.[F5]
    'u = h1.Range("B" & Rows.Count).End(xlUp).Row
    'If u = 1 Then
        'MsgBox "No hay registros con los criterios seleccionados", vbExclamation, "PA"
        'Exit Sub
    'End If
    '
    H1.Range("B12:J" & u). Copy h2. Range("B12")
    H1.Range("L12:M" & u). Copy h2. Range("L12")
    H1.Range("O12:O" & u). Copy h2. Range("O12")
Range("A12:O" & u). EntireColumn. AutoFit
Range("A12:O" & u). EntireRow. AutoFit
End If
End Sub

Favor una ayuda.

1 respuesta

Respuesta
2

Entiendo que se trata de mostrar también las fórmulas en col K y N

En lugar de copiar por rangos :

H1.Range("B12:J" & u). Copy h2. Range("B12")
    H1.Range("L12:M" & u). Copy h2. Range("L12")
    H1.Range("O12:O" & u). Copy h2. Range("O12"

Copia todo junto en 1 sola línea:

H1.Range("B12:O" & u). Copy h2. Range("B12")

PD) en próximo video irá la explicación del armado de fórmulas con VBA :)

¡Gracias! Elsa por el aporte.

Estaré atento al video.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas