Hi ho, ich mal wieder. Auf meinen letzten Beitrag hab ich keine Hilfe erhalten, aber hab es zumindest gelöst bekommen.

Allerdings sieht nun mein Code bissl behindert aus, da er viel zu viele Zeilen frisst. Ich aber die schleifenfunktion nicht hinbekomme-... k.a was ich da falsch mache.

so funktioniert mein code :

Dim merker As Integer
merker = 0
Application.ScreenUpdating = False
    If (Cells(24, 13) > 0) Then
    Cells(24, 13).Copy
    Worksheets("BP Übersicht").Range("B8").PasteSpecial Paste:=xlPasteValues
    Worksheets("BP Übersicht").Range("B5").PasteSpecial Paste:=xlPasteValues
    Cells(24, 9).Copy
    Worksheets("BP Übersicht").Range("B9").PasteSpecial Paste:=xlPasteValues

    merker = merker + 1
    Application.CutCopyMode = False
    ElseIf (Cells(23, 13) > 0) Then
        Cells(23, 13).Copy
        Worksheets("BP Übersicht").Range("B8").PasteSpecial Paste:=xlPasteValues
        Worksheets("BP Übersicht").Range("B5").PasteSpecial Paste:=xlPasteValues
        Cells(23, 9).Copy
        Worksheets("BP Übersicht").Range("B9").PasteSpecial Paste:=xlPasteValues

        merker = merker + 1
        Application.CutCopyMode = False
        ElseIf (Cells(22, 13) > 0) Then
            Cells(22, 13).Copy
            Worksheets("BP Übersicht").Range("B8").PasteSpecial Paste:=xlPasteValues
            Worksheets("BP Übersicht").Range("B5").PasteSpecial Paste:=xlPasteValues
            Cells(22, 9).Copy
            Worksheets("BP Übersicht").Range("B9").PasteSpecial Paste:=xlPasteValues
            merker = merker + 1
            Application.CutCopyMode = False
    ElseIf (Cells(21, 13) > 0) Then
    Cells(21, 13).Copy
    Worksheets("BP Übersicht").Range("B8").PasteSpecial Paste:=xlPasteValues
    Worksheets("BP Übersicht").Range("B5").PasteSpecial Paste:=xlPasteValues
    Cells(21, 9).Copy
    Worksheets("BP Übersicht").Range("B9").PasteSpecial Paste:=xlPasteValues
    merker = merker + 1
    Application.CutCopyMode = False
    ElseIf (Cells(20, 13) > 0) Then
        Cells(20, 13).Copy
        Worksheets("BP Übersicht").Range("B5").PasteSpecial Paste:=xlPasteValues
        Worksheets("BP Übersicht").Range("B8").PasteSpecial Paste:=xlPasteValues
        Cells(20, 9).Copy
        Worksheets("BP Übersicht").Range("B9").PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        merker = merker + 1
        ElseIf (Cells(20, 13) > 0) Then
            Cells(20, 13).Copy
            Worksheets("BP Übersicht").Range("B5").PasteSpecial Paste:=xlPasteValues
            Worksheets("BP Übersicht").Range("B8").PasteSpecial Paste:=xlPasteValues
            Cells(20, 9).Copy
            Worksheets("BP Übersicht").Range("B9").PasteSpecial Paste:=xlPasteValues
            merker = merker + 1
            Application.CutCopyMode = False

          Application.CutCopyMode = False
            End If
If merker = 0 Then
 
    Worksheets("BP Übersicht").Activate
    Worksheets("BP Übersicht").Range("B5").Select
    Selection.Value = "Kein Kessel angeschlossen"

    ElseIf merker = 1 Then
    merker = merker - 1
    End If
        Application.CutCopyMode = False
    Worksheets("BP1 Standzeit-Abfüllzeit").Activate
Application.ScreenUpdating = True

joa, copy funktioniert wunderbar , kann nun wirklich mit der letzten zelle die ein wert ( also größer 0 ) arbeiten, alles super, der code läuft , könne auch so bleiben,

aber wenn jemand das in eine schleife bekommt, um den code zu kürzen, wäre ich dennoch dankbar, da mein hirn den knick gerade nich machen mag