H o l a:
Te anexo la macro:
Sub Procesamiento(l2, vigen, h1, i, ruta, arch, hoja, borr, cole, colp)
'Por.Dante Amor
Set h2 = l2.Sheets(vigen)
uc = h1.Cells(2, h1.Columns.Count).End(xlToLeft).Column
For j = h1.Columns("D").Column To uc
msj2 = ""
numest = h1.Cells(2, j)
estado = "s" & h1.Cells(2, j)
archestado = Dir(ruta & estado & "*.xlsx")
Application.StatusBar = "Leyendo archivo: " & arch & ". Actualizando estado: " & estado
If archestado = "" Then
msj2 = "No existe archivo estado: " & estado
Else
Set l3 = Workbooks.Open(ruta & archestado)
If ExisteHoja(l3, UCase(hoja)) Then
Set h3 = l3.Sheets(hoja)
fila = 10
Do While h3.Cells(fila, "B") <> ""
fila = fila + 1
Loop
If borr = "SI" Then
h3.Rows("10:" & fila - 1).Delete
fila = 10
End If
u2 = h2.Cells(h2.Rows.Count, cole).End(xlUp).Row
h2.Range("A1:AZ" & u2).AutoFilter Field:=cole, Criteria1:="=" & numest
If h2.Cells(2, cole) <> "" Then
'Sí hay registros a copiar
u2 = h2.Cells(h2.Rows.Count, cole).End(xlUp).Row
'
cds = Split(colp, "-")
h2.Range(h2.Cells(2, cds(0)), h2.Cells(u2, cds(1))).Copy
h3.Range("B" & fila).Insert Shift:=xlDown
msj2 = "Procesado"
Else
msj2 = "No hay registros a copiar"
End If
Else
msj2 = "No existe hoja destino: " & hoja
End If
l3.Close True
End If
h1.Cells(i, j) = msj2
Next
End Sub
':)
'S aludos. D a n t e A m o r . R ecuerda valorar la respuesta. G racias
':)