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
Respuesta de Dante Amor
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
