excel - traer - VBA copia datos de un libro de trabajo a otro
macro para importar datos de un libro a otro (2)
Solo estoy explorando el VBA e intento usarlo para copiar una selección de datos de un libro de trabajo a otro. El primer libro ''enviar'' tiene información entre A: D y el número de filas puede cambiar. El ''receptor'' tendrá la información recopilada de muchos ''enviar'' por lo que estos datos deben copiarse debajo de la última información. Encontré este código a continuación y lo modifiqué, pero me da un código de tiempo de ejecución 9 y me cae en ''lMaxRows_t'' Cualquier idea o ayuda muy apreciada
Sub CopyData()
Dim sBook_t As String
Dim sBook_s As String
Dim sSheet_t As String
Dim sSheet_s As String
Dim lMaxRows_t As Long
Dim lMaxRows_s As Long
Dim sMaxCol_s As String
Dim sRange_t As String
Dim sRange_s As String
sBook_t = "//scceastfl5/~/tester receiver.xlsx"
sBook_s = "//scceastfl5/~/tester send.xlsx"
sSheet_t = "Sheet1"
sSheet_s = "Sheet1"
lMaxRows_t = Workbooks(sBook_t).Sheets(sSheet_t).Cells(Rows.Count, "A").End(xlUp).Row
lMaxRows_s = Workbooks(sBook_s).Sheets(sSheet_s).Cells(Rows.Count, "A").End(xlUp).Row
sMaxCol_s = Workbooks(sBook_s).Sheets(sSheet_s).Cells(1, Columns.Count).End(xlToLeft).Address
sMaxCol_s = Mid(sMaxCol_s, 2, InStr(2, sMaxCol_s, "$") - 2)
If (lMaxRows_t = 1) Then
sRange_t = "A1:" & sMaxCol_s & lMaxRows_s
sRange_s = "A1:" & sMaxCol_s & lMaxRows_s
Workbooks(sBook_t).Sheets(sSheet_t).Range(sRange_t) = Workbooks(sBook_s).Sheets(sSheet_s).Range(sRange_s).Value
Else
sRange_t = "A" & (lMaxRows_t + 1) & ":" & sMaxCol_s & (lMaxRows_t + lMaxRows_s - 1)
sRange_s = "A2:" & sMaxCol_s & lMaxRows_s
Workbooks(sBook_t).Sheets(sSheet_t).Range(sRange_t) = Workbooks(sBook_s).Sheets(sSheet_s).Range(sRange_s).Value
End If
End Sub
Sub CopyData()
Dim wb1 As Workbook
Dim wb2 As Workbook
''Set workbooks
Set wb1 = Workbooks.Open("c:/Path/of/your/file.xlsx")
Set wb2 = Workbooks.Open("c:/Path/of/your/file1.xlsx")
''clear all data
wb2.Sheets(1).Cells.Clear
''Copy data from wb1 sheet 1 to sheet 1 in wb2
With wb1.Sheets(1)
.UsedRange.Copy wb2.Sheets(1).range("A1").end(xldown).offset(1,0)
End With
End Sub
Quizás así sea, esto debería ser fácil de editar:
Option Explicit
Sub AddToMaster()
''this macro goes IN the master workbook
Dim wsMaster As Worksheet, wbDATA As Workbook
Dim NextRow As Long, LastRow As Long
Set wsMaster = ThisWorkbook.Sheets("Sheet1")
NextRow = wsMaster.Range("A" & Rows.Count).End(xlUp).Row + 1
Set wbDATA = Workbooks.Open("//scceastfl5/~/tester send.xlsx")
With wbDATA.Sheets("Sheet1")
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
If LastRow > 19 Then
.Range("A20:E" & LastRow).Copy
wsMaster.Range("A" & NextRow).PasteSpecial xlPasteValues
wsMaster.Range("A" & NextRow).PasteSpecial xlPasteFormats
End If
End With
wbDATA.Close False
End Sub
Esta versión está en el libro de trabajo de SENDER:
Option Explicit
Sub SendToMaster()
''this macro goes IN the sender workbook
Dim wsSEND As Worksheet, wbMASTER As Workbook
Dim NextRow As Long, LastRow As Long
Set wsSEND = ThisWorkbook.Sheets("Sheet1")
LastRow = wsSEND.Range("A" & Rows.Count).End(xlUp).Row
Set wbMASTER = Workbooks.Open("//scceastfl5/~/tester receiver.xlsx")
With wbMASTER.Sheets("Sheet1")
NextRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
wsSEND.Range("A20:E" & LastRow).Copy
.Range("A" & NextRow).PasteSpecial xlPasteValues
.Range("A" & NextRow).PasteSpecial xlPasteFormats
End With
wbMASTER.Close True ''save and close the master
End Sub