Excel 2010 mit VBA sortieren ?

Hallo miteinander,

Ich habe die Aufgabe mit Excel einen Dateiordner auszulesen und diese in Excel nach 2 Kriterien in 2 Spalten zu sortieren.
Als absoluter Vollleie konnte ich mit Hilfe des Internets und ein paar hilfsbereiten User von diesem Forum nun geschafft den Ordner auszulesen.
Die Sortierung nach den 2 Spalten wollte ich mit Hilfen von Formeln durchführen was bei meinem Text auch funktioniert hat.

Für das bessere Verständnis
In der Tabelle 2 werden die Dateinamen aufgelistet und in der Tabelle 1 die sortierte Liste.

Dies hat in meinem Test funktioniert.
Wenn ich jedoch die Excel-Datei schliesse und wieder öffne, braucht Ecxel über 30 Minuten um die Datei zum öffnen.
Ich muss dazu sagen das ich nach 30 Minuten abgebrochen habe,

Ich vermute das das Macro das die Dateiliste erstellt einen komflikt mit der Formel in der Tabelle 1 bekommt.
Das die Formel jedesmall wenn eine neue Datei dazukommt wieder von vorne beginnt mit der Berechnung.

Deshalb meine Frage, kann die Sortierung der Dateien direkt in VBA-Code während dem einlesen gemacht werden ?

Hier mein Code der die Dateinamen in Excel schreibt.
Das auslesen der 2500 Dateien erfolgt in ca. 10 Sek.


Wäre echt super wenn mir jemand helfen könnte.
Andy

Sub WriteSortedListToSheet()
    'work on sheet 1  
    With Sheets(1)
        ' get sorted list of filenames from directory  
        Set Files = GetSortedFileList("\\10.20.50.200\archiv")  
        r = 1
        'write file names to sheet  
        While Not Files.EOF
            .Cells(r, 1).Value = Files.Fields("name").Value  
            Files.MoveNext
            r = r + 1
        Wend
    End With
End Sub

Function GetSortedFileList(strFolder)
    Set objList = CreateObject("ADOR.Recordset")  
    Set fso = CreateObject("Scripting.Filesystemobject")  
    objList.Fields.Append "name", 200, 255  
    objList.Fields.Append "date", 7  
    objList.Open
    For Each file In fso.GetFolder(strFolder).Files
        objList.AddNew
        objList("name").Value = file.Name  
        objList("date").Value = file.DateLastModified  
        objList.Update
    Next
    objList.Sort = "name"  
    Set GetSortedFileList = objList
    Set fso = Nothing
    Set objList = Nothing
End Function

With Sheets(1)
    .Columns(1).Sort .Columns(1), xlAscending
End with

Sub WriteSortedListToSheet()
    On Error Resume Next
    Dim col As Integer
    'work on sheet 1  
    With Sheets(1)
        ' get sorted list of filenames from directory  
        Set Files = GetSortedFileList("\\10.20.50.200\archiv")  
        r = 1
        'write file names to sheet  
        While Not Files.EOF
            'Spalte aus dem Dateinamen ermitteln  
            col = Int(Split(Split(Files.Fields("name").Value, "_", 2, 1)(1), ".", 2, 1)(0))  
            If Err.Number <> 0 Then
                 MsgBox "Dateiname '" & Files.Fields("name").Value & "' konnte keiner Spalte zugeordnet werden!", vbExclamation  
                Err.Clear
            Else
                'Dateiname in nächste freie Zeile der jeweiligen Spalte schreiben  
                .Cells(Rows.Count, col).End(xlUp).Offset(1, 0).Value = Files.Fields("name").Value  
            End If
            'nächster Name  
            Files.MoveNext
        Wend
    End With
End Sub