Como exportar datos de un libro a otro libro ya existente
Necesito exportar datos desde un libro base, hoja base a un libro de destino, ya existente, hoja Desc_105. Los datos pueden estar filtrados en la hoja base del libro base y se requiere exportar a un libro destino, hoja Desc_105, según datos filtrados en columna D. Posteriormente se filtrará según nuevo código y se enviará a libro destino 2 hoja Desc_115, y así según códigos que sean necesarios filtra y exportar. En la hoja de destino los datos deben ordenarse según ejemplo (Varía el orden de algunas columnas de destino).
Se requiere solución con macros.
LIBRO BASE
LIBRO DESTINO (Hoja Desc_105)
1 respuesta
Respuesta de Dante Amor
2
H o la:
Te anexo la macro para exportar los datos
Sub ExportarDatos()
'Por.Dante Amor
Application.ScreenUpdating = False
Set l1 = ThisWorkbook
Set h1 = l1.Sheets(1)
ruta = l1.Path & "\"
'
h1.Columns("M").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).ClearContents
u1 = h1.Range("A" & Rows.Count).End(xlUp).Row
h1.Range("A2:G" & u).Copy
h2.[A2].PasteSpecial xlValues
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
