Makro udfører ikke alt

Hej!
Nedenstående makro åbner en excel fil og sletter rækkerne i den, men vil ikke sorter dem. Så den afspiller kun halvdelen. Hvordan kan jeg får den til at fortsætte?

Sub Macro1()

Workbooks.Open Filename:="C:\Users\Bruger\Documents\Roskilde.xlsx"
   
Dim sidsteRække As Integer, ræk As Integer
 

    sidsteRække = ActiveCell.SpecialCells(xlLastCell).Row
   
    For ræk = 1 To sidsteRække
        If Range("C1") = "Roskilde" Then
            Exit Sub
        Else
            Rows("1:1").Delete
        End If
  Next ræk


    Columns("A:J").Select
    ActiveWorkbook.Worksheets("prog2013").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("prog2013").Sort.SortFields.Add Key:=Range( _
        "D2:D893"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("prog2013").Sort
        .SetRange Range("A1:G893")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
End Sub