VBA Wenn Zelle belegt dann nächste...

Sub Rueckgabeantrag()
Dim Rueckgabe As String
Dim intLZ As Integer
Dim i As Integer
Dim j As Integer
Dim Finish As String
Dim Menge As String
Dim Zähler As Long
With Sheets("Kundenteile")
intLZ = .Cells(Rows.Count, 16).End(xlUp).Row
For i = 1 To intLZ
If .Cells(i, 16).Value = "a" Then
Zähler = Zähler + 1
Rueckgabe = .Range("p" & i).Value
For j = i To intLZ
If Rueckgabe = .Range("p" & j).Value Then
Finish = .Cells(j, 5)
Worksheets("Tabelle1").Cells(19, 2) = Finish
Menge = .Cells(j, 7)
Worksheets("Tabelle1").Cells(19, 4) = Menge
.Cells(j, 16).ClearContents
Worksheets("Tabelle1").Visible = True
End If
Next j
End If
Next i
End With
If Zähler = 0 Then
MsgBox "Es wurden keine Teile selektiert"
Else
MsgBox "Rückgabeantrag erfolgreich gesendet"
End If
End Sub