Maybe the below assuming the list starts in cell A2:

Sub FindFilesAndMove()    
    Dim MyFolder As String, MyFile As String, srchStr As String, DestFold As String, FSO As Object, rCell As Range
   
    Set FSO = CreateObject("Scripting.Filesystemobject")
    MyFolder = "C:\Users\jbloggs\Desktop\test\" '<<< change to suit
    
    For Each rCell In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row).Cells
        MyFile = Dir(MyFolder)
        srchStr = rCell.Value
        DestFold = MyFolder & srchStr & "\"
        MkDir DestFold
        
        Do While MyFile <> ""
            If InStr(MyFile, srchStr) Then
                FSO.MoveFile Source:=MyFolder & MyFile, Destination:=DestFold & MyFile
            End If
            MyFile = Dir
        Loop
    Next rCell
End Sub