Hallo

Um die Zellwerte der Spalte A, Tabelle 2 mit den Zellwerten in Spalte Q, Tabelle 1 zu vergleichen und bei gleichem Wert soll die nachfolgenden Zellen B,C,D,E,F, Tabelle 2 in die entsprechend Zeile (des gleichen Wertes) in die Zellen R,S,T,U,V,W kopiert werden, habe ich ein VBA, welches zwar ohne Bug durchläuft, jedoch werden die vgt. Zellen nicht in das Tabellenblatt 1 kopiert. Hat jemand eine Idee, warum dies nicht kopiert wird:

Sub WerteVergleichenUndKopieren()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim lastRow1 As Long
Dim lastRow2 As Long
Dim i As Long
Dim j As Long

' Arbeitsblätter definieren
Set ws1 = ThisWorkbook.Sheets("Tabelle1")
Set ws2 = ThisWorkbook.Sheets("Tabelle2")

' Letzte Zeile in beiden Tabellen bestimmen
lastRow1 = ws1.Cells(ws1.Rows.Count, 18).End(xlUp).Row
lastRow2 = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row

' Durchlaufe alle Zeilen in Tabelle 2, Spalte A
For i = 2 To lastRow2
' Durchlaufe alle Zeilen in Tabelle 1, Spalte Q

Set gef = ws1.Range("Q:Q").Find(ws2.Cells(i, 1).Value)
If Not gef Is Nothing Then
j = gef.Row
' Wenn gleich, kopiere die Werte
ws1.Cells(j, 19).Value = ws2.Cells(i, 2).Value ' Kopiere B -> S
ws1.Cells(j, 20).Value = ws2.Cells(i, 3).Value ' Kopiere C -> T
ws1.Cells(j, 21).Value = ws2.Cells(i, 4).Value ' Kopiere D -> U
ws1.Cells(j, 22).Value = ws2.Cells(i, 5).Value ' Kopiere E -> V
ws1.Cells(j, 23).Value = ws2.Cells(i, 6).Value ' Kopiere F -> W
End If
Next i

MsgBox "Werte wurden erfolgreich kopiert!", vbInformation

End Sub

Gruss

Olli