Sub createdirectory()
Application.ScreenUpdating = False
Dim ch As String, rep As String, fichier As String
ch = ThisWorkbook.Path & "\"
For i = 2 To Feuil1.[a6500].End(xlUp).Row
rep = Feuil1.Range("c" & i)
If Dir(ch & rep & "\", vbDirectory) = vbNullString Then
MkDir (ch & rep & "\")
End If
Workbooks.Add
With ActiveWorkbook
fichier = ch & rep & "\" & Feuil1.Range("b" & i) & ".xlsx"
If Dir(fichier) = vbNullString Then
.SaveAs fichier
.Close
Else
.Close
End If
End With
Next
End Sub