varios traer pasar para otro macro libros libro importar extraer enlazar desde datos copiarlos como buscar actual excel vba copy

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