Try this

Sub abcd()
 Dim TheNames As Range, cell As Range
 Dim AL, MZ
 Dim TempSort As String
 Dim NoExchanges As Integer
 
 
 Set TheNames = Range("b5:b40")
 
    ReDim AL(1 To 1)
    ReDim MZ(1 To 1)
    For Each cell In TheNames
       If Left(cell, 1) <= "L" Then
           AL(UBound(AL)) = cell
           ReDim Preserve AL(1 To UBound(AL) + 1)
       End If
       If Left(cell, 1) >= "M" Then
           MZ(UBound(MZ)) = cell
           ReDim Preserve MZ(1 To UBound(MZ) + 1)
       End If
    Next
    ReDim Preserve AL(1 To UBound(AL) - 1)
    ' Loop until no more "exchanges" are made.
    Do
        NoExchanges = True
        ' Loop through each element in the array.
        For i = 1 To UBound(AL) - 1
            ' If the element is greater than the element
            ' following it, exchange the two elements.
            If AL(i) > AL(i + 1) Then
                NoExchanges = False
                TempSort = AL(i)
                AL(i) = AL(i + 1)
                AL(i + 1) = TempSort
            End If
        Next i
    Loop While Not (NoExchanges)
    
    ReDim Preserve MZ(1 To UBound(MZ) - 1)
    ' Loop until no more "exchanges" are made.
    Do
        NoExchanges = True
        ' Loop through each element in the array.
        For i = 1 To UBound(MZ) - 1
            ' If the element is greater than the element
            ' following it, exchange the two elements.
            If MZ(i) > MZ(i + 1) Then
                NoExchanges = False
                TempSort = MZ(i)
                MZ(i) = MZ(i + 1)
                MZ(i + 1) = TempSort
            End If
        Next
    Loop While Not (NoExchanges)
    
    Worksheets("Sheet2").Range("b5").Resize(UBound(AL)) = WorksheetFunction.Transpose(AL)
    Worksheets("Sheet3").Range("b5").Resize(UBound(MZ)) = WorksheetFunction.Transpose(MZ)
End Sub