Macro agrega columna a un filtro

Hola DAM.

De acuerdo a la anterior macro, debo adicionar en la ultima columna o sea en la columna J, el valor que aparece en cada archivo en la celda c3, osea cada registro debe aparecer con ese valor que debo adicionar a la macro anterior.

gracias

Omar

1 Respuesta

Respuesta
1

Te anexo la macro con los cambios

Sub Filtrar()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets("Hoja1")
    h1.Cells.Clear
    Set h3 = l1.Sheets("datos")
    ruta = l1.Path & "\"
    ChDir ruta
    '
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Selecciona una carpeta"
        .AllowMultiSelect = False
        .InitialFileName = ruta
        If .Show <> -1 Then Exit Sub
        cp = .SelectedItems(1)
    End With
    '
    ChDir cp & "\"
    archi = Dir("*.xls*")
    Do While archi <> ""
        Set l2 = Workbooks.Open(archi)
        Set h2 = l2.ActiveSheet
        h2.Range("A13:H" & h2.Range("E" & Rows.Count).End(xlUp).Row).AdvancedFilter _
            Action:=xlFilterInPlace, _
            CriteriaRange:=h3.Range("A1:B3"), Unique:=False
        u = h2.Range("E" & Rows.Count).End(xlUp).Row
        If u > 13 Then
            u1 = h1.Range("E" & Rows.Count).End(xlUp).Row + 1
            h2.Rows(14 & ":" & u).Copy h1.Range("A" & u1)
            u3 = h1.Range("E" & Rows.Count).End(xlUp).Row
            h1.Range("J" & u1 & ":J" & u3) = h2.[C3]
        End If
        l2.Close False
        archi = Dir()
    Loop
    Application.ScreenUpdating = True
    MsgBox "Terminado"
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas