Kopieren Sie Zellenwerte in die nächste leere Zeile in eine andere Arbeitsmappe. Vba

Question

Ich habe zwei separate Excel-Dateien. In einer davon in Sheet1 sind Informationen über Bestellungen und Bestellnummern gespeichert. Jetzt jedes Mal, wenn ich eine neue Bestellung mache, möchte ich diese Informationen aus meiner Bestellung gesammelt und in so genannte "Datenbank" Arbeitsmappe eingefügt werden. Er sollte die letzte leere Zeile in Spalte A: A in C:\Users\user\Desktop\Order_number.xlsx identifizieren und neue Werte aus dem Bereich ("C6,C17,C10,H18,B32,G32,H6,H9") in die nächste leere Zeile einfügen. Hier ist der Code, den ich gefunden habe, aber es gibt einen Fehler und es funktioniert nicht. Wie kann es behoben werden?

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

Einige Korrekturen:

1) Set wsData = Workbooks("C:\Users\user\Desktop\Order_number.xlsx").Sheets("Sheet1") wird nicht funktionieren. Verwenden Sie entweder Set wsData = Workbooks("Order_number.xlsx").Sheets("Sheet1"), wenn die Arbeitsmappe geöffnet ist. Oder Sie müssen zuerst die Arbeitsmappe öffnen.

2) Ich bin nicht vertraut mit Application.WorksheetFunction.CountA(wsData.Range("A:A")), um die letzte Zeile zu erhalten. Um die letzte Zeile in Spalte A zu erhalten (mit der Möglichkeit, leere Zellen in der Mitte zu überspringen), verwenden Sie wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row.

3) Meine Präferenz ist Copy >> Paste xlPasteValues ​​ mit cl.Copy und der folgenden Zeile wsData.Range("A" & C).PasteSpecial xlPasteValues zu verwenden.

-Code

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