Разделить текст в конкретном месте пробелами

Sub bb()
Dim strTemp As String, StrZnak  As String, strNew As String, i%, k%, u%
strTemp = Trim$("ЧЕЛ01976 БЭ")
k = Len(strTemp)
For i = k To 1 Step -1
    StrZnak = Mid$(strTemp, i, 1)
    If i = k - 2 And StrZnak <> " " Then StrZnak = StrZnak & " ": u = 1
    If i = k - 8 + u And StrZnak <> " " Then StrZnak = StrZnak & " "
    strNew = StrZnak & strNew
Next
MsgBox strNew
End Sub

Function InsertSomeCHR(strInput As String, strCHR As String, arr)
   Dim strTemp$, lngIndex&, counter&
      strInput = Replace(Application.Trim(strInput), " ", "")
     counter = 0
       For lngIndex = 1 To Len(strInput)
         strTemp = IIf(lngIndex = 1, Mid$(strInput, lngIndex, arr(counter)), _
                                 strTemp & strCHR & Mid$(strInput, lngIndex, arr(counter)))
         lngIndex = lngIndex + CLng(arr(counter)) - 1: counter = counter + 1
            If counter > UBound(arr) Then
               strTemp = strTemp & strCHR & Mid$(strInput, lngIndex + 1): Exit For
            End If
     Next 'lngIndex
    InsertSomeCHR = strTemp
End Function
 '@ @ @ @ @ @ @ @ @ @ @ @ @ @ @ 
Sub test()
   Dim marr(), mstr$, myCHAR$
   marr = Array(3, 5, 3, 8, 3, 3, 2): myCHAR = " " ' только для Вас - указан пробел.
   mstr = "MQGSVTEFLKPRLVDIEQVSSTHAKVTLEPLERGFGHTLG"
    Debug.Print InsertSomeCHR(mstr, myCHAR, marr)
End Sub

Function sobr(s$)
    s = Replace(s, " ", "")
    sobr = Left(s, 3) & " " & Mid(s, 3, 5) & " " & Right(s, 3)
End Function