Welcome to VBAX.
Give this a try. Make sure that your Target folder location is not contained in the Source folder. If you need to search C: to locate all jpg files, the target will need to be excluded to avoid endless loop.
Option Explicit
Option Compare Text
Dim LookingFor As String
Dim SourcePth As String
Dim TargetPth As String
Sub SearchAll()
Dim FSO As Object
Dim Pth As String
'Set options
SourcePth = "C:\bbb\" '<=== Enter path containing jpg files
TargetPth = "C:\aaa\" '<=== Enter path to receive new folders
LookingFor = "jpg" 'Process filter if required
Set FSO = CreateObject("Scripting.FileSystemobject")
Call ProcessFolder(FSO, SourcePth, True)
Set FSO = Nothing
End Sub
Private Function ProcessFolder( ByRef FSO As Object, ByVal Foldername As String, Optional ByVal Init As Boolean)
Dim Fldr As Object
Dim SubFldr As Object
Dim File As Object
Set Fldr = FSO.GetFolder(Foldername)
'Process head folder once only
If Init = True Then
For Each File In Fldr.Files
ProcessFiles Fldr, File
Next File
End If
On Error Resume Next
For Each SubFldr In Fldr.SubFolders
'Handle restricted folders e.g Recylce Bin
If Not Err = 70 Then
For Each File In SubFldr.Files
ProcessFiles SubFldr, File
Next File
Call ProcessFolder(FSO, SubFldr.Path)
End If
Next SubFldr
'Clean up
Set File = Nothing
Set SubFldr = Nothing
Set Fldr = Nothing
End Function
'Process details
Sub ProcessFiles(Fld, f)
Dim NewFolder As String
If f.Name Like "*" & LookingFor Then
If InStr(f.Name, "-") > 0 Then
NewFolder = TargetPth & Split(f.Name, "-")(0)
On Error Resume Next
MkDir NewFolder
On Error GoTo 0
Name f As NewFolder & "\" & f.Name
End If
End If
End Sub