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

Excel 将下一空行中的单元格值复制到另一工作簿vba,excel,vba,Excel,Vba,我有两个单独的Excel文件。其中一张表1中存储了有关订单和订单号的信息。现在,每次我下新订单时,我都希望从订单中收集这些信息,并将其插入到所谓的数据库工作簿中。它应该识别C:\Users\user\Desktop\Order\u number.xlsx中A:A列中的最后一个空行,并将范围C6、C17、C10、H18、B32、G32、H6、H9中的新值插入下一个空行。这是我找到的代码,但有一些错误,它不起作用。如何修复它 Sub TransferValues465() Dim wsMa

我有两个单独的Excel文件。其中一张表1中存储了有关订单和订单号的信息。现在,每次我下新订单时,我都希望从订单中收集这些信息,并将其插入到所谓的数据库工作簿中。它应该识别C:\Users\user\Desktop\Order\u 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
一些更正:

1设置wsData=Workbooks C:\Users\user\Desktop\Order\u number.xlsx.SheetsSheet1将不起作用。如果工作簿处于打开状态,请使用Set wsData=WorkbooksOrder_number.xlsx.SheetsSheet1。或者您需要先打开工作簿

2我不习惯使用Application.WorksheetFunction.CountAwsData.range来获取最后一行。要获得列A中的最后一行,有可能跳过中间的BALNK单元,使用WSDATA CELLSWSDATA ROWSCOUNT,A.EntXLUP.ROUL.

3我的首选是将Copy>>PasteSpecial xlPasteValues与cl.Copy和以下行wsData.RangeA&C.PasteSpecial xlPasteValues一起使用

代码


您已经声明了wsMain两次,但未声明wsData。请帮助执行文件的打开和关闭命令。应打开Order_number.xlsx,输入值,保存并关闭文件。谢谢大家!@mrwad现在试试代码,添加了打开、关闭和保存部分。非常感谢您的帮助!现在唯一的问题是,您的代码正在插入值以垂直顺序排列_number.xlsx。我需要将它们水平插入。换句话说,它将插入列A中的所有值,我需要将它们插入到下一个空行中。请看我的密码。我已经更新了。现在,除了保存和关闭外,它工作正常。@mrwad您需要更清楚,将它们放在下一个空行中,意味着将它们全部放在A列中。是否希望它们都放在同一行中?让我们假设第10行是第一个空行,所以您希望tp将值粘贴到A10,然后是B10、C10等等?完全正确!对不起,我不太懂所有的术语!我想把这些值粘贴到A10,然后是B10,C10等等?
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