Hallo Sepp.
Leider fuktioniert das immernoch nicht so wie ich will (Effizienz), deshalb hier nochmal das komplette Makro:
Die Berechnung soll ja auf
WENN(UND('1DayROC'!B4 umgestellt werden.
Ich schaffe das irgendwie nicht so einzufügen, dass es nicht Zelle für zelle berechnet. Danke für die Hilfe!
Option Explicit
Sub Changes() Dim rng As Range Dim c As Integer, maxc ' Anzahl der Spalten Dim lngE As Long 'für letzte gefüllte Zeile Dim lngRow As Long 'Zeilenzähler in "ROCs" Dim wsPos As Worksheet, wsNeg As Worksheet, wsROCs As Worksheet Set wsPos = Worksheets("Pos") Set wsNeg = Worksheets("Neg") Set wsROCs = Worksheets("ROCs") 'Lösche wsPos.Cells.Delete Shift:=xlUp wsNeg.Cells.Delete Shift:=xlUp 'Übertrage Erste Spalte und erste Zeile aus Datablatt Application.CutCopyMode = False wsPos.Select wsROCs.Columns("A:A").Copy wsPos.Range("A1").Select wsPos.Paste wsROCs.Rows("1:1").Copy wsPos.Range("A1").Select wsPos.Paste wsPos.Range("A1").Select maxc = 1 With wsROCs 'Letzte gefüllte Zelle in Zeile 1 (Überschrift) ermitteln While IsEmpty(.Cells(1, maxc)) = False: maxc = maxc + 1: Wend If maxc < 2 Then Exit Sub 'Letzte gefüllte Zelle in Spalte "B" ermitteln lngE = IIf(IsEmpty(.Range("B65536")), .Range("B65536").End(xlUp).Row, 65536) For c = 2 To maxc lngRow = 2 For Each rng In wsROCs.Range(.Cells(2, c), .Cells(lngE, c)) If rng <> "" And rng.Offset(1, 0) <> "" Then 'wenn Zelle in Zeile r und r+1 gefüllt dann wsPos.Cells(lngRow + 1, c) = (rng.Offset(1, 0) / rng) - 1 lngRow = lngRow + 1 'Zeilenzähler erhöhen End If Next rng Next c End With End Sub