Sub folder() Dim folderPath As String folderPath = Sheets(2).[B1] Dim fso As Object Set fso = CreateObject("Scripting.FileSystemObject") Dim n As Variant n = fso.GetFolder(folderPath).SubFolders.Count
If (0 < n) Then Dim I As Long I = 1 Dim f As Object For Each f In fso.GetFolder(folderPath).SubFolders Cells(3 + I,1).Value=Str(f.Name) I = I + 1 Next f End If End Sub