复制单元格值到下一个空行到另一个工作簿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