|
Hallo,
so ich hab es so probiert, habe es aber nicht zum laufen bekommen.
http://www.xn--frank-mller-zhb.net/Verteilungweb.xlsm
Also ich schaffe es nicht, dass er 100 mal neuberechnet und die neue Lösung kopiert.
Ich habe die Sicherung der letzten Version rausgenommen, da die Kopie von Sicherung1 nach 2 schon eine Neuberechnung auslöst und damit die gefunden Lösung verloren geht.
Irgendwo muss jetzt ein
Else ' Sheets(2).Calculate
oder sowas rein damit auch wenn der Wert D3 nicht größer ist als D4 und das kopieren nicht für eine Neuberechung sorgt dann durch ein Else das übernommen wird aber ich weiß nicht wohin und ob da noch was nötig is für das Else
Sub sicherung()
Dim CRange$
Dim TS As Object, TS2 As Object
Set TS = Sheets("TabelleSicherung")
Set TS2 = Sheets("TabelleSicherung2")
For a = 1 To 8
With Sheets(1)
If .Cells(3, 4).Value > .Cells(4, 4).Value Then
.UsedRange.Copy
With TS.Cells(1, 1)
.PasteSpecial (xlFormats)
.PasteSpecial (xlValues)
End With
.Cells(4, 4).Value = .Cells(3, 4).Value
End If
' Sheets(2).Calculate
Application.CutCopyMode = False
End With
Next
End Sub
Vielen Dank für die Hilfe
|