Cómo puedo copiar datos de 8 libros distintos a 32 plantillas, utilizando un filtro para pegar los datos que corresponden

H o l a:

Te anexo la macro para copiar:

Sub ProcesarInformacion()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.StatusBar = False
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets(1)
    Set h12 = l1.Sheets(2)
    '
    'variables
    ruta = l1.Path & "\"
    vigen = "VIGENTES"
    'Lipiar hoja
    u = h1.Range("A" & Rows.Count).End(xlUp).Row
    If u < 3 Then u = 3
    uc = h1. Cells(2, h1. Columns. Count).End(xlToLeft). Column
 h1. Range(h1.Cells(3, "B"), h1. Cells(u, uc)). ClearContents
    '
    For i = 3 To u
        msj1 = ""
        arch = h1.Cells(i, "A") & ".xlsx"
        hoja = h12.Cells(i, "B")
        borr = h12.Cells(i, "C")
        cole = h12.Cells(i, "D")    'columna estado
        colp = h12.Cells(i, "E")    'columnas copiar
        If arch = "" Then msj1 = "Falta poner el nombre del libro (8)"
        If hoja = "" Then msj1 = "Falta configurar la hoja"
        If borr = "" Then msj1 = "Falta configurar el estado de borrar"
        If cole = "" Then msj1 = "Falta configurar la columna estado"
        If colp = "" Then msj1 = "Falta configurar las columnas copiar"
        If Dir(ruta & arch) = "" Then msj1 = "No existe archivo"
        '
        Application.StatusBar = "Leyendo archivo: " & arch & "."
        If msj1 = "" Then
            Set l2 = Workbooks.Open(ruta & arch, , True)
            If ExisteHoja(l2, vigen) Then
                Procesamiento l2, vigen, h1, i, ruta, arch, hoja, borr, cole, colp
            Else
                msj1 = "No existe hoja Vigentes"
            End If
            l2.Close
            Set l2 = Nothing
        End If
        'Actualizar estatus
        h1.Cells(i, "B") = Now
        h1.Cells(i, "C") = msj1
    Next
    Application.StatusBar = False
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "Fin"
End Sub

':)
':)