将下一个空白行中的单元格值复制到另一个工作簿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）我不熟悉使用Application.WorksheetFunction.CountA(wsData.Range("A:A"))来获取最后一行。 要获取A列的最后一行（可以跳过中间的空白单元格），请使用wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row 。

3）我的偏好是使用带有cl.Copy Copy >> PasteSpecial xlPasteValues和以下行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