Como exportar datos de un libro a otro libro ya existente II

Se presenta libro base, el cual mediante macro lleva a otros libros, según requerimiento, información respecto a conceptos asociados. También se presenta como queda la información en el libro de llegada.

Se necesita mediante macro unas modificaciones para que la información de llegada se presente como se indica en el libro de destino. (Cambiar un par de columnas y agregar totales como se indica en ejemplo, ojalá ennegrecidos).

LIBRO BASE

LIBRO DESTINO

1

1 Respuesta

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

Te anexo la macro actualizada

Sub ExportarDatos()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets(1)
    ruta = l1.Path & "\"
    '
    h1.Columns("M:N").ClearContents
    u = h1.Range("D" & Rows.Count).End(xlUp).Row
    h1.Range("D1:D" & u).Copy h1.Range("M1")
    u2 = h1.Range("M" & Rows.Count).End(xlUp).Row
    h1.Range("M1:M" & u2).RemoveDuplicates Columns:=1, Header:=xlYes
    '
    For i = 2 To h1.Range("M" & Rows.Count).End(xlUp).Row
        If h1.AutoFilterMode = False Then h1.[A1].AutoFilter
        codigo = h1.Cells(i, "M")
        h1.Range("A1:G" & u).AutoFilter Field:=4, Criteria1:=codigo
        libro = "DESC_" & codigo & ".xlsx"
        hoja = "DESC_" & codigo
        '
        If Dir(ruta & libro) <> "" Then
            Set l2 = Workbooks.Open(ruta & libro)
            existe = False
            For Each h In l2.Sheets
                If h.Name = hoja Then
                    existe = True
                    Exit For
                End If
            Next
            If existe Then
                Set h2 = l2.Sheets(hoja)
                h2.UsedRange.Offset(1, 0).Clear
                u1 = h1.Range("A" & Rows.Count).End(xlUp).Row
                h1.Range("A2:B" & u).Copy
                h2.[A2].PasteSpecial xlValues
                '
                H1.Range("E2:E" & u). Copy
                h2.[C2].PasteSpecial xlValues
                '
                H1.Range("D2:D" & u). Copy
                h2.[D2].PasteSpecial xlValues
                '
                H1.Range("C2:C" & u). Copy
                h2.[E2].PasteSpecial xlValues
                '
                H1.Range("F2:G" & u). Copy
                h2.[F2].PasteSpecial xlValues
                '
                u2 = h2.Range("A" & Rows.Count).End(xlUp).Row + 2
                h2.Cells(u2, "C") = "TOTALES"
                h2.Cells(u2, "E") = "=SUM(E2:E" & u2 - 1 & ")"
                h2.Cells(u2, "F") = "=SUM(F2:F" & u2 - 1 & ")"
                h2.Cells(u2, "G") = "=SUM(G2:G" & u2 - 1 & ")"
                h2.Rows(u2).Font.Bold = True
                h2.Columns("E:G").NumberFormat = "#,##0"
                '
                l2.Save
                h1.Cells(i, "N") = "Se exportaron los dato"
            Else
                h1.Cells(i, "N") = "No existe la hoja " & hoja
            End If
            l2.Close False
        Else
            h1.Cells(i, "N") = "No existe el libro " & libro
        End If
    Next
    '
    h1.AutoFilterMode = False
    'h1.Columns("M:N").ClearContents
    Application.ScreenUpdating = True
    MsgBox "Se exportaron los datos", vbInformation, "EXPORTAR DATOS"
End Sub

S a l u d o s . D a n t e   A m o r. Recuerda valorar la respuesta. G r a c i a s

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas