Makro lukker excel under kørsel

Jeg har fundet en makro, jeg måske kan bruge når der foretages et par rettelser.
Problemet er, at makroen genererer en fejl og lukker excel ned.
Hvis jeg stepper gennem koden trin for trin kører den ok, men når den køres fra arket, lukker den, hvorfor?
Jeg bruger xl97, hvis det betyder noget.
Koden er som følger:

Sub ShowTheForm()
UserForm1.Show
End Sub
Sub SortAndRemoveDupes()
Dim rListSort As Range, rOldList As Range
Dim strRowSource As String

'Clear Hidden sheet Column A ready for list
  Sheet1.Range("A1", Sheet1.Range("A65536").End(xlUp)).Clear
 

'Set range variable to list we want
  Set rOldList = Sheet2.Range("A1", Sheet2.Range("A65536").End(xlUp))

'Use AdvancedFilter to copy the list to Column A _
  of the hidden sheet and remove all dupes
  rOldList.AdvancedFilter Action:=xlFilterCopy, _
              CopyToRange:=Sheet1.Cells(1, 1), Unique:=True
             
'Set range variable to the new non dupe list
  Set rListSort = Sheet1.Range("A1", Sheet1.Range("A65536").End(xlUp))

    With rListSort
            'Sort the new non dupe list
            .Sort Key1:=.Cells(2, 1), Order1:=xlAscending, Header:=xlYes, _
                  OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    End With
   
    'Parse the address of the sorted unique items
          strRowSource = Sheet1.Name & "!" & Sheet1.Range _
          ("A2", Sheet1.Range("A65536").End(xlUp)).Address
 
    Sheet1.Range("A1") = "New Sorted Unique List"
  With UserForm1.ListBox1
      'Clear old ListBox RowSource
      .RowSource = vbNullString
      'Parse new one
      .RowSource = strRowSource
  End With
 
End Sub