Création de dossier

Bonjour à tous,

J'aimerais créer des dossiers en fonction d'un gros fichier Excel.

Ceux ci se nommerai selon le nom de la cellule K et se trouverai dans le dossier du nom de la feuille.

J'ai commencer un bout de code qui ne fonctionne malheureusement pas et c'est la que j'ai besoin de votre aide

Sub creation_repertoire_bloc()

On Error Resume Next
nbOnglet = ThisWorkbook.Sheets
For i = 1 To nbOnglet
Sheets(i).Select
With Sheets(i)
For j = 1 To Sheets(i).Range("K65000").End(xlUp).Row
If .Range("K" & j) <> "" Then
repParent = Left(ThisWorkbook.Path, InStrRev(ThisWorkbook.Path, "\") - 1)
ChDir repParent
Dim chemin As String
chemin = repParent & "\BLOCS\" & ActiveSheet.Name & "\" & Cells("K" & j).Value
If Dir(chemin) = "" Then MkDir chemin
End If

Next j
End With
Next i

End Sub

Voila, si vous avez besoin de plus d'informations n'hésitez pas c'est peut être pas compréhensible pour vous.

Je me suis rendu compte de plusieurs erreurs déjà notamment le "On error resume next"

J’enlève le MkDir et le remplace par set oFld mais la c'est le chemin qui fait beuger le programme...

Sub creation_repertoire_bloc()

Dim oFSO As Scripting.FileSystemObject
Dim oDrv As Drive
Dim oFld As Folder
Set oFSO = New Scripting.FileSystemObject

NbOnglet = ThisWorkbook.Sheets.Count
For i = 1 To NbOnglet
Sheets(i).Select
With Sheets(i)
For j = 1 To Sheets(i).Range("K65000").End(xlUp).Row
If .Range("K" & j) <> "" Then
repParent = Left(ThisWorkbook.Path, InStrRev(ThisWorkbook.Path, "\") - 1)
ChDir repParent
Dim chemin As String
chemin = repParent & "\BLOCS\" & ActiveSheet.Name & "\" & Cells("K" & j).Value
Set oFld = oFSO.CreateFolder("chemin")

End If

Next j
End With
Next i

End Sub