Option Explicit
Sub kopierePreise()
Dim wbPreiseNeu, wbPreiseAlt As Workbook
Dim lngLetzteZeileProdukteAlt, lngLetzteZeileProdukteNeu As Long
Dim strPreiseAlt As String
Dim curPreisAlt As Currency
Dim rngPreiseAlt As Range
Dim i As Integer
strPreiseAlt = "Preise_alt.xlsx"
Set wbPreiseNeu = ThisWorkbook
Application.Workbooks.Open strPreiseAlt
Set wbPreiseAlt = Workbooks(strPreiseAlt)
lngLetzteZeileProdukteNeu = wbPreiseNeu.Sheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Row
With wbPreiseAlt.Sheets("Tabelle1")
lngLetzteZeileProdukteAlt = .Cells(Rows.Count, 1).End(xlUp).Row
Set rngPreiseAlt = .Range(.Cells(1, 1), .Cells(lngLetzteZeileProdukteAlt, 3))
End With
For i = 2 To lngLetzteZeileProdukteNeu
With wbPreiseNeu.Sheets("Tabelle1")
On Error Resume Next
curPreisAlt = Application.VLookup(.Cells(i, 1).Value, rngPreiseAlt, 3, False)
If curPreisAlt = 0 Then
.Cells(i, 2).Value = ""
Else
.Cells(i, 2).Value = curPreisAlt
End If
curPreisAlt = 0
End With
Next i
End Sub