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
|