複製單元格值到下一個空行到另一個工作簿vba

Question

我有兩個單獨的Excel文件。在Sheet1中的其中一個存儲關於訂單和訂單號碼的信息。現在，每次我訂購新訂單時，都希望從我的訂單收集這些信息，並將其插入到所謂的「數據庫」工作簿中。它應該識別C:\Users\user\Desktop\Order_number.xlsx中列A：A中的最後一個空行，並將範圍爲("C6,C17,C10,H18,B32,G32,H6,H9")的新值插入到下一個空行。這裏是我提出的代碼，但有一些錯誤，它不起作用。如何修復？

Sub TransferValues465() 

Dim wsMain As Worksheet: Set wsMain = ThisWorkbook.ActiveSheet 
Dim wsData As Worksheet: Set wsData = Workbooks.Open("C:\Users\user\Desktop\Order_number.xlsx").Sheets("Sheet1") 
Dim rngToCopy As Range: Set rngToCopy = wsMain.Range("C6,C17,C10,H18,B32,G32,H6,H9") 
Dim c As Long 
Dim ar As Range 
Dim cl As Range 

Dim LastRow As Long 

Dim rngDestination As Range 

With Application 
     .DisplayAlerts = False 
     .ScreenUpdating = False 
     .EnableEvents = False 
End With 

'Get the last row in Database sheet: 
LastRow = wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row 
Set rngDestination = wsData.Cells(LastRow + 1, 1).Resize(1, 25).Offset(0, 0) 

For Each ar In rngToCopy.Areas 
    For Each cl In ar 
     c = c + 1 
     'I used this next line for testing: 
     ' rngDestination.Cells(c).Value = cl.Address 
     rngDestination.Cells(c).Value = cl.Value 
    Next 
Next 

End Sub 

Answer 1

一些更正：

1）Set wsData = Workbooks("C:\Users\user\Desktop\Order_number.xlsx").Sheets("Sheet1")將無法​​正常工作。如果工作簿已打開，請使用Set wsData = Workbooks("Order_number.xlsx").Sheets("Sheet1")。或者你需要先打開工作簿。

2）我不是famliar使用Application.WorksheetFunction.CountA(wsData.Range("A:A"))得到最後一行。要獲得A列中的最後一行（可能在中間跳過balnk單元格），請使用wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row。

3）我的選擇是使用複製>> PasteSpecial的xlPasteValues與cl.Copy和下面的行wsData.Range("A" & C).PasteSpecial xlPasteValues。

代碼

Option Explicit 

Sub TransferValues465() 

Dim wsMain As Worksheet 
Dim wbData As Workbook 
Dim wsData As Worksheet 
Dim rngToCopy As Range 
Dim C As Long 
Dim ar As Range 
Dim cl As Range 

Dim LastRow As Long 
Dim rngDestination As Range 

Set wsMain = ThisWorkbook.ActiveSheet 

Application.DisplayAlerts = False 
' you need to open the workbook 
Set wbData = Workbooks.Open("C:\Users\user\Desktop\Order_number.xlsx") 
Set wsData = wbData.Sheets("Sheet1") 
Set rngToCopy = wsMain.Range("C6,C17,C10,H18,B32,G32,H6,H9") 

'Get the last row in Database sheet: 
LastRow = wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row 

C = 1 
For Each cl In rngToCopy 
    cl.Copy 
    wsData.Cells(LastRow + 1, C).PasteSpecial xlPasteValues 
    C = C + 1 
Next cl  

wbData.Close True '<-- close and save the changes made 
Application.DisplayAlerts = True '<-- restore settings 

End Sub