Navn fra fane, indtil mellemrum

Jeg har nogle faner med forskellige navne, initialer og fornavn
Jeg vil gerne have initialer til at stå på alle sider i A1, men hvordan får jeg den til at tage de første bogstaver indtil mellemrum? Jeg har forsøgt med Mid(sname, 1, " ") men det dur ikke. Det dur med et bestemt antal, men initialer er fra 2 til 4 bogstaver.

Koden ser sådan ud
Sub IndsætNavn()
    Dim ws As Worksheet
    Dim sname As String
    For Each ws In Worksheets
        ws.Select
    sname = ActiveSheet.Name
    ActiveSheet.Range("A1").Value = Mid(sname, 1, 4)
    Next ws
End Sub