セルの値を次の空の行にコピーして別のブックvba

Question

別のExcelファイルが2つあります。 Sheet1のこれらの1つには、注文と注文番号に関する情報が格納されています。今私が新しい注文をするたびに、私はこの情報を注文から収集し、いわゆる "データベース"ワークブックに挿入します。列A：Aの最後の空行をC:\Users\user\Desktop\Order_number.xlsxに指定し、("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を使用します（途中でbalnkセルをスキップする可能性があります）。

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