将单元格值复制到下一个空行到另一个工作簿vba

我有两个单独的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）我不熟悉使用Application.WorksheetFunction.CountA(wsData.Range("A:A"))获取最后一行。 要获得列A中的最后一行（可能在中间跳过balnk单元格），请使用wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row 。

3）我的首选是使用Copy >> 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