Sort Worksheets with numbered sheets first and text sheets last

[skidz]

I need a Macro to sort all sheets in a workbook by name that puts numbered (i.e. 6,7,8,9,10) first and then text names last. (i.e. "Samples", "Content") So it would look like 6,7,8,9,10,20,115,Content, Samples.

Here is what I have so far that does the numbered sheets correctly but puts the text named sheets first.

Sub WorksheetsSortAscending()
' sort worksheets in a workbook in ascending order
Dim sCount As Integer, i As Integer, j As Integer
sCount = Worksheets.Count
If sCount = 1 Then Exit Sub
For i = 1 To sCount - 1
For j = i + 1 To sCount
If Val(Worksheets(j).Name) < Val(Worksheets(i).Name) Then
Worksheets(j).Move before:=Worksheets(i)
End If
Next j
Next i
End Sub

[Mumps1]

Try:

Sub SortSheets()
Dim I As Integer, ii As Integer
    Dim ShtName As String
    If ActiveWorkbook.Sheets.count > 1 Then
        On Error Resume Next
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        Sheets("SheetNames").Visible = True
        Sheets("SheetNames").Delete
        On Error GoTo 0
        Sheets.Add().Name = "SheetNames"
        Application.DisplayAlerts = True
        With ThisWorkbook.Sheets("SheetNames")
            .Visible = xlSheetVeryHidden
            .Columns(20).Clear
             
            For I = 1 To ActiveWorkbook.Sheets.count
                If Sheets(I).Name <> "SheetNames" Then
                    .Cells(I, 20) = Sheets(I).Name
                End If
            Next
             
            .Columns(20).Sort Key1:=.Cells(1, 20), Order1:=xlAscending
             
            For ii = I - 2 To 1 Step -1
                ShtName = .Cells(ii, 20)
                ActiveWorkbook.Sheets(ShtName).Move Before:=ActiveWorkbook.Sheets(1)
            Next
             
        End With
    End If
Application.ScreenUpdating = True
End Sub

[skidz]

Try:

Sub SortSheets()
Dim I As Integer, ii As Integer
    Dim ShtName As String
    If ActiveWorkbook.Sheets.count > 1 Then
        On Error Resume Next
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        Sheets("SheetNames").Visible = True
        Sheets("SheetNames").Delete
        On Error GoTo 0
        Sheets.Add().Name = "SheetNames"
        Application.DisplayAlerts = True
        With ThisWorkbook.Sheets("SheetNames")
            .Visible = xlSheetVeryHidden
            .Columns(20).Clear
             
            For I = 1 To ActiveWorkbook.Sheets.count
                If Sheets(I).Name <> "SheetNames" Then
                    .Cells(I, 20) = Sheets(I).Name
                End If
            Next
             
            .Columns(20).Sort Key1:=.Cells(1, 20), Order1:=xlAscending
             
            For ii = I - 2 To 1 Step -1
                ShtName = .Cells(ii, 20)
                ActiveWorkbook.Sheets(ShtName).Move Before:=ActiveWorkbook.Sheets(1)
            Next
             
        End With
    End If
Application.ScreenUpdating = True
End Sub

That errors (out of range) when it gets to "ActiveWorkbook.Sheets(ShtName).Move Before:=ActiveWorkbook.Sheets(1)"

It does begin to resort them though I cant really tell how it was going to do it.

[Mumps1]

Could you post your file?