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