Makro wird nicht vollständig ausgeführt

Sub SuchListe()
'On Error Resume Next
Application.ScreenUpdating = False
Dim Zeile As Long
Dim i As Long
i = Sheets("Normal").Cells(65536, 3).End(xlUp).Row
For Zeile = 6 To i
With Sheets("Normal")
Sheets("Schnellsuche").Cells(Zeile - 5, 1) = .Cells(Zeile, "C") & IIf(Not IsEmpty(.Cells(Zeile,  _
"D")), ", " _
& .Cells(Zeile, "D"), "")
Sheets("Schnellsuche").Cells(Zeile - 5, 2) = .Cells(Zeile, "E")
Sheets("Schnellsuche").Cells(Zeile - 5, 3) = .Cells(Zeile, "F")
Sheets("Schnellsuche").Cells(Zeile - 5, 4) = .Cells(Zeile, "G")
Sheets("Schnellsuche").Cells(Zeile - 5, 5) = .Cells(Zeile, "H")
Sheets("Schnellsuche").Cells(Zeile - 5, 6) = .Cells(Zeile, "I")
Sheets("Schnellsuche").Cells(Zeile - 5, 7) = .Cells(Zeile, "J")
Sheets("Schnellsuche").Cells(Zeile - 5, 8) = .Cells(Zeile, "K")
Sheets("Schnellsuche").Cells(Zeile - 5, 11) = .Cells(Zeile, "B")
Sheets("Schnellsuche").Cells(Zeile - 5, 21) = .Cells(Zeile, "U")
Sheets("Schnellsuche").Cells(Zeile - 5, 22) = .Cells(Zeile, "V")
Sheets("Schnellsuche").Cells(Zeile - 5, 23) = .Cells(Zeile, "W")
Sheets("Schnellsuche").Cells(Zeile - 5, 24) = .Cells(Zeile, "X")
Sheets("Schnellsuche").Cells(Zeile - 5, 25) = .Cells(Zeile, "Y")
End With
Next
With Sheets("Schnellsuche")
.Unprotect
Columns.Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1,  _
MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
.Protect
Application.ScreenUpdating = True
End With
End Sub

Das Problem liegt darin, dass wenn das Makro über Workbook_Open gestartet wird, wird der letzte Teil des Makros nicht ausgeführt (sprich die Sortierung). Wenn ich aber die Makro in der VBA Umgebung mit F5 starte, klappt alles reibunglos.
Kann jemand einen Fehler erkennen?
Gruß
Martin