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

Question

我只是在探索VBA并尝试使用它将数据从一个工作簿复制到另一个工作簿。 第一本书'send'的信息介于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 

这个版本进去发件人工作簿：

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