Sort Excel Sheets In Custom Order Based On Value In A List

[bakerman]

Sub MoveSheetAround()

    Dim lng As Long
    Dim wks As Worksheet
    Dim lngCrVlu As Long
    Dim rng As Range
    With Worksheets("Sheet1")
        Set rng = .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
    End With
    For lng = 1 To rng.Rows.Count
        For Each wks In ThisWorkbook.Worksheets
            If wks.Name <> "Sheet1" And wks.Cells(5, 3).Value = rng.Cells(lng).Value Then
                wks.Move After:=ThisWorkbook.Sheets(lng + 2)
                Exit For
            End If
        Next wks
    Next lng
    
End Sub