For m = 0 To 20
For k = 1 To 12
ThisWorkbook.Worksheets("Objekt " & wks.Cells(i, 19).Value).Cells(32 + k + m * 15, 2).FormulaR1C1 = "='Quotenermittlung'!R" & 9 + k + m * 12 & "C" & 4 * j + 3
Next k
Next m
Exit For
End If
Next j
End If
Set ws = ThisWorkbook.Worksheets("Objekt " & wks.Cells(i, 19).Value)
ws.Visible = True
If ws.Cells(8, 6).Value = 0 Then
n = 6
Else
n = ws.Cells(8, 1000).End(xlToLeft).Column + 6
End If
If wks.Cells(i, 26).Value <> wks.Cells(i - 1, 26).Value Then
If n > 6 Then
ws.Range(ws.Cells(8, n - 6), ws.Cells(346, n - 6 + 5)).Copy
ws.Range(ws.Cells(8, n), ws.Cells(346, n + 5)).PasteSpecial
ws.Cells(17, n + 1).Value = 0
End If
ws.Cells(8, n).Value = Right(wks.Cells(i, 26).Value, Len(wks.Cells(i, 26).Value) - InStrRev(wks.Cells(i, 26).Value, "-", , vbTextCompare))
ws.Cells(9, n).Value = wks.Cells(i, 26).Value
ws.Cells(11, n).Value = wks.Cells(i, 24).Value
ws.Cells(17, n + 1).Value = ws.Cells(17, n + 1).Value + wks.Cells(i, 21).Value
ws.Cells(33, 4).FormulaR1C1 = ws.Cells(33, 4).FormulaR1C1 & "+RC[" & n & "]"
Else
If wks.Cells(i, 24).Value <> wks.Cells(i - 1, 24).Value And i <> 4 Then
MsgBox ("Warnung")
End If
<strong> ws.Cells(17, n - 5).Value = ws.Cells(17, n - 5).Value + wks.Cells(i, 21).Value</strong>
End If