Sub FolderCreator()

    Dim objRow As Range, objCell As Range, strFolders As String, rootFolder As String

    With Application.FileDialog(msoFileDialogFolderPicker)
        ' show the file picker dialog box
        If .Show <> 0 Then
            rootFolder = .SelectedItems(1)
              End If
    End With

    For Each objRow In ActiveSheet.UsedRange.Rows
        strFolders = rootFolder
        For Each objCell In objRow.Cells
            strFolders = strFolders & "\" & objCell
        Next
        Shell ("cmd /c md " & Chr(34) & strFolders & Chr(34))
    Next

End Sub