comboboxen plötzlich alle leer :-/

Sub fuerklaus()
Dim i, r, c As Integer
r = ActiveCell.Row
c = ActiveCell.Column
With Worksheets("Tool")
For i = r To r + 39
.Rows(i).RowHeight = 20
With .Shapes.AddOLEObject(ClassType:="Forms.ComboBox.1", _
DisplayAsIcon:=False, _
Link:=False, _
Left:=.Cells(i, c).Left, _
Top:=.Cells(i, c).Top, _
Width:=.Cells(i, c).Width, _
Height:=.Cells(i, c).Height)
' Linked Cell setzen und Einträge zufügen
With .DrawingObject
.LinkedCell = Cells(i, c).Address
With .Object
.AddItem "100"
.AddItem "95"
.AddItem "90"
.AddItem "85"
.AddItem "80"
.AddItem "75"
.AddItem "70"
.AddItem "65"
.AddItem "60"
.AddItem "55"
.AddItem "50"
.AddItem "45"
.AddItem "40"
.AddItem "35"
.AddItem "30"
.AddItem "25"
.AddItem "20"
.AddItem "15"
.AddItem "10"
.AddItem "5"
.AddItem "0"
End With
End With
End With
Next
End With
End Sub