Option Explicit
Sub Bereinigen()
Dim lngErsteZeile As Long
Dim lngLetzteZeile As Long
Dim lngLaufZahl As Long
lngLetzteZeile = 4
lngErsteZeile = 6
Do
With ActiveSheet
For lngLaufZahl = lngErsteZeile To lngLetzteZeile Step -1
If .Cells(lngLaufZahl, "F") <> "" Then
.Cells(lngLetzteZeile - 1, "F") = .Cells(lngLaufZahl, "F")
.Range(.Cells(lngLetzteZeile, "F"), .Cells(lngLaufZahl, "F")).Select
Selection.ClearContents
Exit For
End If
Next lngLaufZahl
End With
lngLetzteZeile = lngLetzteZeile + 4
lngErsteZeile = lngErsteZeile + 4
If lngErsteZeile > 170 Then Exit Do
Loop
ActiveSheet.Range("F3").Activate
End Sub