[ChrisGT7]

Καλημέρα Θάνο,

Δοκίμασε τον παρακάτω κώδικα να δεις αν είναι αυτό που ζητάς:

Option Explicit

Sub GetFileNames()
    Dim xRow As Long, xCol As Long, MyCell As String
    Dim xDirect$, xFname$, InitialFoldr$
    InitialFoldr$ = "C:\"
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = Application.DefaultFilePath & "\"
        .Title = "Επιλέξτε το φάκελο με την λίστα των αρχείων"
        .InitialFileName = InitialFoldr$: .Show
        If .SelectedItems.Count = 0 Then Exit Sub
        
        xDirect$ = .SelectedItems(1) & "\"
        xFname$ = Dir(xDirect$, 7)
        Do While xFname$ <> ""
            ActiveCell.Offset(xRow) = xFname$
            ActiveCell.Offset(xRow, 1) = Mid(xFname$, 1, Len(xFname$) - 4)
            xRow = xRow + 1
            xFname$ = Dir
        Loop
        
        xCol = ActiveCell.Column + 2
        xRow = Cells(Rows.Count, xCol - 1).End(xlUp).Row
        MyCell = "OFFSET(INDIRECT(ADDRESS(ROW(),COLUMN())),,-1)"
        Range(Cells(ActiveCell.Row, xCol), Cells(xRow, xCol)).Formula = _
            "=RIGHT(" & MyCell & ",SUM(LEN(" & MyCell & ")-LEN(SUBSTITUTE(" & MyCell & ",{0,1,2,3,4,5,6,7,8,9},""""))))"
        
        Range(Cells(ActiveCell.Row, xCol - 2), Cells(Rows.Count, xCol)).Sort _
            Key1:=Cells(ActiveCell.Row, xCol), Order1:=xlAscending, DataOption1:=xlSortTextAsNumbers
        Range(Cells(ActiveCell.Row, xCol - 1), Cells(Rows.Count, xCol)).ClearContents
    End With
End Sub

Όπως αναφέρει και ο Γιάννης, η ταξινόμηση δε γίνεται σε επίπεδο αριθμού αλλά σε επίπεδο κειμένου, π.χ. το 10 είναι μικρότερο του 2, γιατί συγκρίνεται ένα-ένα ψηφίο και όχι όλος ο αριθμός μαζί.

Στον παραπάνω κώδικα χρησιμοποιούνται δύο βοηθητικές στήλες, όπου στην πρώτη εξάγεται το όνομα του αρχείου χωρίς την κατάληψη και στη δεύτερη εξάγονται μόνο οι αριθμοί. Τέλος, ταξινομούνται οι τρεις στήλες ως προς τη στήλη με τους αριθμούς και καθαρίζονται οι δύο τελευταίες στήλες ώστε να μείνει η πρώτη των αρχείων.