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