Makro markiert nicht gewünschte Zellen

Sub Spalte()

Dim aktz As Object, cell1 As Object, cell2 As Object
Dim zeil As Integer, spalt As Integer

Set aktz = ActiveCell
zeil = aktz.Row: spalt = aktz.Column
If IsEmpty(aktz) Then Exit Sub
'oberes Spaltenende suchen, Endzelle in zelle1 speichern
For zeil = aktz.Column To 1 Step -1
If IsEmpty(Cells(zeil, spalt).Value) Then
Set cell1 = Cells(zeil + 1, spalt)
Exit For
End If
Next zeil
If cell1 Is Nothing Then Set cell1 = Cells(zeil, 1)
'unteres Spaltenende suchen, Endzelle in zelle2 speichern
For zeil = aktz.Column To 1770
If IsEmpty(Cells(zeil, spalt).Value) Then
Set cell2 = Cells(zeil - 1, spalt)
Exit For
End If
Next zeil
If cell2 Is Nothing Then Set cell2 = Cells(zeil, spalt)
'den Bereich zwischen zelle1 und zelle2 markieren
MsgBox cell1
MsgBox cell2
Range(cell1, cell2).Select
End Sub

Nun die Probleme: er gibt als ERgebnis stets 8 aus und die Zellen werden nicht markiert. Lass ich das Makro jedoch schritt für schritt ablaufen, dann markiert er den bereich..was läuft da falsch?

Vielen Dank!