CODE Zusammenfassen oder umschreiben

Sub Eintragen()
Dim rng As Range, i As Integer, a As Integer, k As Integer
Set rng = Range("C1")
For i = 1 To 25
If IsEmpty(rng) Then
End If
Set rng = rng.Offset(0, 0)
If rng = "x" Then rng.Offset(0, 6).Value = rng.Offset(0, -2)
Next
'Section2
k = 1
For a = 1 To 25
If Not IsEmpty(Cells(a, 9)) Then
Cells(k, 10).Value = Cells(a, 9).Value
'Cells(a, 9).ClearContents
k = k + 1
Else
End If
Next
End Sub