VBA Zeilen werden mehrfach kopiert
31.05.2021 22:39:57
Paddy
Ich habe einen Worksheet mit zwei Sheets, die auf Übereinstimmungen in Spalte H untersucht werden. Werden also in Spalte H im zweiten Sheet Übereinstimmungen zu Spalte H im ersten Sheet gefunden, so soll die gesamte betroffene Zeile aus dem zweiten Sheet in den dritten Sheet kopiert werden. Bei dem entsprechenden Ergebnis sollen zu dem Meldungen ausgegeben werden, ob die Suche erfolgreich war.
Folgenden Code habe ich dafür geschrieben:
Sub Kundenvergleich()
Dim x As Integer, y As Integer
Dim v As Long
Dim lastrow1 As Integer, lastrow2 As Integer, Kundennummer As String
Dim NextRow As Integer
lastrow1 = Sheets(1).Cells(Rows.Count, 8).End(xlUp).Row
lastrow2 = Sheets(2).Cells(Rows.Count, 8).End(xlUp).Row
Application.ScreenUpdating = False
v = 0
For x = 2 To lastrow1
Kundennummer = Sheets(1).Cells(x, 8)
For y = 2 To lastrow2
If Sheets(2).Cells(y, 8) = Kundennummer Then
Sheets(2).Cells(y, 1).Resize(1, 14).Copy
Sheets(3).Select
NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
Sheets(3).Cells(NextRow, 1).Select
Sheets(3).Paste
v = v + 1
End If
Next
Next
Application.ScreenUpdating = True
If v > 0 Then
MsgBox "Übereinstimmungen wurden in den Reiter /Ergebnis/ kopiert.", vbInformation, "Übereinstimmungen gefunden"
Else
MsgBox "Es konnten keine Übereinstimmungen ermittelt werden. Sie können die Abfrage schließen", vbCritical, "Keine Übereinstimmungen"
End If
End Sub
Kann mir das einer erklären und mir dabei helfen, den Code dahingehend anzupassen, dass jede betroffene Zeile nur einmal kopiert wird?
Danke für den Support und liebe Grüße
Paddy