in erste leere Zelle in Spalte eintragen

Sub Eintragen()
Dim zelle As Range
Dim r As Long
Dim i As Long
On Error Resume Next
For Each zelle In Range("c9:c56")
r = zelle.Row
With Worksheets(zelle.Value)
i = 21
If (.Cells(i, 2)) = "" Then
.Cells(i, 2) = Cells(r, 11)
.Cells(i, 3) = Cells(r, 13)
.Cells(i, 4) = Cells(r, 15)
.Cells(i, 6) = Cells(r, 17)
.Cells(i, 7) = Cells(r, 22)
.Cells(i, 8) = Cells(r, 23)
Else
i = i + 1
.Cells(i, 2) = Cells(r, 11)
.Cells(i, 3) = Cells(r, 13)
.Cells(i, 4) = Cells(r, 15)
.Cells(i, 6) = Cells(r, 17)
.Cells(i, 7) = Cells(r, 22)
.Cells(i, 8) = Cells(r, 23)
End If
End With
Next
End Sub