Macro que me pase información a otra hoja en base al criterio fecha

Recién me ayudaste en una macro que funciona como filtro avanzado.

La consulta es que solo quiero extraer datos solo de ciertas columnas.

Las columnas en morado son las que quiero extraer información, la hoja se llama "Importaciones".

Quiero extraer a esta hoja llamada FORMATO DE DESCARGA, es decir si pongo la fecha en b2, extraiga la información de la hoja Importaciones solo de las columnas que están en color morado, es decir en base a la fecha debe mostrar la información.

Espero puedas ayudarme.

Respetuosamente.

Juan Arenas.

1 respuesta

Respuesta
1

Te envío la macro actualizada, solamente tienes que actualizar las columnas que quieras copiar en esta línea:

    cols = Array("C", "E", "F", "G", "H")   'completar las columnas

La macro completa:

Sub Macro2()
'Por Dante Amor
    Application.ScreenUpdating = False
    Set h1 = Sheets("Importaciones")
    Set h2 = Sheets("FORMATO DE DESCARGA")
    If h1.AutoFilterMode Then h1.AutoFilterMode = False
    If h2.Range("B2").Value = "" Or Not IsDate(h2.Range("B2").Value) Then
        MsgBox "Falta indicar la fecha"
        Exit Sub
    End If
    h2.Rows("8:" & Rows.Count).ClearContents
    '
    fec = Format(h2.Range("B2").Value, "mm/dd/yyyy")
    u1 = h1.Range("A" & Rows.Count).End(xlUp).Row
    uc = h1.Cells(7, Columns.Count).End(xlToLeft).Column
    h1.Range("A7", h1.Cells(u1, uc)).AutoFilter Field:=3, _
        Operator:=xlFilterValues, Criteria2:=Array(2, fec)
    '
    'COPIAR columnas
    u1 = h1.Range("A" & Rows.Count).End(xlUp).Row
    cols = Array("C", "E", "F", "G", "H")   'completar las columnas
    k = 1
    If u1 > 7 Then
        For j = LBound(cols) To UBound(cols)
            h1.Range(h1.Cells(8, cols(j)), h1.Cells(u1, cols(j))).Copy
            h2.Cells(8, k).PasteSpecial xlValues
            k = k + 1
        Next
        MsgBox "Datos copiados"
    Else
        MsgBox "No existen datos"
    End If
    Range("B2").Select
    If h1.AutoFilterMode Then h1.AutoFilterMode = False
    Application.ScreenUpdating = False
    Application.CutCopyMode = False
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