Macro pour répertorier les dossiers d'un chemin d'accès

Eh, ce gros bricolage est ce que je voulais que tu nous proposes.
Pas question pour moi de faire ton boulot. Mais dès lors que c'est le produit de ton propre effort, je veux bien t'aider à l'améliorer. Et même à en faire quelque chose de très pro  

------------------------------------------

Ma bien-nommée variable folder est un objet Folder, élément de la collection Folders.
C'est donc un objet qui propose plusieurs méthodes et attributs. L'attribut par défaut est Path, c'est pourquoi tu obtients la même chose que moi en ne rien précisant. Mais je préfère être explicite.
Et si on utilisait l'attribut Name plutôt ?

Sub liste_projet()
	Const chemin = "D:\DONNEES\"
	Dim FSO As Object, folder As Object
 
	Set FSO = CreateObject("Scripting.FileSystemObject" )
 
	For Each folder In FSO.GetFolder(chemin).SubFolders
		MsgBox "Le sous-dossier courant est : " & folder.Path & "." & vbCrLf & "Son petit nom est : " & folder.Name & "."
	Next
 
End Sub

Bon maintenant, associer une validation à une cellule :

Range("K15" ).Select
With Selection.Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
    xlBetween, Formula1:="a;b;c;d;e"
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = ""
    .ErrorTitle = ""
    .InputMessage = ""
    .ErrorMessage = ""
    .ShowInput = True
    .ShowError = True
End With

Beurk  

Alors déjà, quand je vois un Select suivi d'un Selection, je condense ! (cherche sur ce site pourquoi... allez...)
Et je retire le With, parce que ça me perturbe quelque peu.
Et puis il ne faut pas mettre des points-virgules, mais des virgules... Merci l'enregistreur de macro  
Tu peux essayer de relancer ta macro, tu n'obtiendras pas le résulat escompté.

Ca donne :

Range("K15" ).Validation.Delete
Range("K15" ).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="a,b,c,d,e"
Range("K15" ).Validation.IgnoreBlank = True
Range("K15" ).Validation.InCellDropdown = True
Range("K15" ).Validation.InputTitle = ""
Range("K15" ).Validation.ErrorTitle = ""
Range("K15" ).Validation.InputMessage = ""
Range("K15" ).Validation.ErrorMessage = ""
Range("K15" ).Validation.ShowInput = True
Range("K15" ).Validation.ShowError = True

Ligne 1, on supprime la validation précédente avant d'en ajouter une nouvelle. C'est prudent.
Ligne 2, on ajoute donc notre liste.
Pour le reste, il semble que ce soient des valeurs par défaut. Bon.

Je vire tout ce qui n'est pas inutile :

Range("K15").Validation.Delete
Range("K15").Validation.Add xlValidateList, , xlBetween, Formula1:="a,b,c,d,e"

Ah bah ça fait du ménage.

Juste une petite vérif :

Range("K15").Validation.Delete
Range("K15").Validation.Add xlValidateList, , xlBetween, Formula1:="a,b,c,d,e,"

J'ai laissé une virgule en trop à la fin. Ca n'a pas l'air de le déranger.  

On reprend avec la boucle sur les sous-dossiers :

Const chemin = "D:\DONNEES\"
 
Dim FSO As Object, folder As Object
Dim chaine As String
 
Range("K15").Validation.Delete
Set FSO = CreateObject("Scripting.FileSystemObject" )
 
chaine = "" ' // Attention, avec VB. On n'est sûr de rien.
For Each folder In FSO.GetFolder(chemin).SubFolders
	chaine = chaine & folder.Name & ","
Next
 
Range("K15").Validation.Add xlValidateList, , xlBetween, Formula1:=chaine

Alors, ne t'avais-je pas dis que c'était simple