VBA将数据从一个工作簿复制到另一个工作簿

我只是探索VBA，并试图用它来从一个工作簿复制到另一个工作簿的select。 第一本书“发送”之间的信息A：D和行数可以改变。 “接收者”将从许多“发送”中收集信息，因此需要将这些数据复制到最后的信息之下。 我发现下面的代码，并修改它，但它给了我一个运行时9代码，并落在'lMaxRows_t'任何想法或帮助非常感谢

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 

Answer 1

也许这样，这应该很容易编辑：

 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 

这个版本进入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 

Answer 2

 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