Cómo puedo insertar información de dos libros a 32 plantillas diferentes, los registros nuevos deben quedar arriba.

Tengo dos libros que deben ser insertados en una pestaña específica cada uno, en 32 plantillas, los datos se insertarían en la parte debajo del encabezado y los registros que contiene (registros viejos), quedarían al final de los nuevos.

1

1 Respuesta

4.208.300 pts. Sancho, si los perros ladran ...

H o l a:

Termino la macro y te la envío para que realices tus pruebas. Sal u dos

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
':)

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas