Ръководства за работа с Excel 2003

naskobk · Октомври 13, 2014

В колони имам оценки от изпити по български и математика с точност до втория знак след десетичната запетая, а в друга таблица трябва да сумирам колко тройки, четворки и т.н. има.
Как да задам да сумира всички оценки в диапазона 3,51 до 4,50, като четворки?
Формулата =COUNTIF((M6:M30);">3,5")-COUNTIF((M6:M30);">=4,5") работи, но ме интересува има ли функция, в която може да се зададе интервала?

Виш примера дали те устройва.................primer_ok_100.xls

kiskin · Октомври 17, 2014

Благодаря ти за съдействието naskobk!

В една таблица имам трите имена в три колони, а в друга ми трябват същите имена в една колона.
Има ли начин да стане автоматично, че иначе ще пада писане?

naskobk · Октомври 17, 2014

Благодаря ти за съдействието naskobk!
В една таблица имам трите имена в три колони, а в друга ми трябват същите имена в една колона.
Има ли начин да стане автоматично, че иначе ще пада писане?

Изпращам ти файл с няколко макроса,

за обединение и разделяне на имена

тествай макросите ако ти харесат може да ги ползваш

ето ти макроса за обединение на три имена в писмен вид,

Sub proTest()

Sheets("Sheet1").Select

Range("d1").Select

Do Until Selection.Offset(0, -3).Value = ""

Selection.Value = Selection.Offset(0, -3).Value & " " & Selection.Offset(0, -2).Value & " " & Selection.Offset(0, -1)

Selection.Offset(1, 0).Select

Loop

Range("A1").Select

End Sub

Маркирай клетка D1 и натисни бутона пълно обединение на имена и виж какво ще се получи

obedinenie na imena_new.xls

naskobk · Ноември 1, 2014

Разработил съм VBA skript na Excel който,

създава директории и под директории,

проблема е, че дава грешка,

когато клетките са празни при създаване на под директориите

този код за главната директория работи добре:

Sub MakeFolders()
Dim LR As Long, cell As Range, rng As Range
With Sheets("Sheet1")
    LR = .Range("a" & Rows.Count).End(xlUp).Row
    For Each cell In .Range("a1:a12" & LR)
        If cell.Value <> "" Then
            If rng Is Nothing Then
                Set rng = cell
            Else
                Set rng = Union(rng, cell)
            End If
        End If
    Next cell
    rng.Select
'Range("a1:a12").Select
Dim maxRows, maxCols, r, c As Integer
Set rng = Selection
maxRows = rng.Rows.Count
maxCols = rng.Columns.Count
For c = 1 To maxCols
r = 1
Do While r <= maxRows
If Len(Dir(ActiveWorkbook.Path & "\" & rng(r, c), vbDirectory)) = 0 Then
MkDir (ActiveWorkbook.Path & "\" & rng(r, c))
On Error Resume Next
End If
r = r + 1
Loop
Next c
End With
End Sub

На този код за създаване на под директории ми дава грешка:

Sub Make_Subfolders()
Dim LR As Long, cell As Range, rng As Range
With Sheets("Sheet1")
    LR = .Range("b" & Rows.Count).End(xlUp).Row
    For Each cell In .Range("b1:b12" & LR)
        If cell.Value <> "" Then
            If rng Is Nothing Then
                Set rng = cell
            Else
                Set rng = Union(rng, cell)
            End If
        End If
    Next cell
    rng.Select
'Range("b1:b12").Select
Dim maxRows, maxCols, r, c As Integer
Set rng = Selection
maxRows = rng.Rows.Count
maxCols = rng.Columns.Count
For c = 1 To maxCols
r = 1
Do While r <= maxRows
If Len(Dir(ActiveWorkbook.Path & "\" & rng(r, c), vbDirectory)) = 0 Then
MkDir (ActiveWorkbook.Path & "\" & Range("A1").Value & "\" & rng(r, c))
If Range("A2").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A2").Value & "\" & rng(r, c))
If Range("A3").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A3").Value & "\" & rng(r, c))
If Range("A4").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A4").Value & "\" & rng(r, c))
If Range("A5").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A5").Value & "\" & rng(r, c))
If Range("A6").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A6").Value & "\" & rng(r, c))
If Range("A7").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A7").Value & "\" & rng(r, c))
If Range("A8").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A8").Value & "\" & rng(r, c))
If Range("A9").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A9").Value & "\" & rng(r, c))
If Range("A10").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A10").Value & "\" & rng(r, c))
If Range("A11").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A11").Value & "\" & rng(r, c))
If Range("A12").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A12").Value & "\" & rng(r, c))

On Error Resume Next
End If
r = r + 1
Do While IsEmpty(Range("b1:b12").Select)
Next c
End With
End Sub

Прилагам примерен файл за разглеждане,auto_dir_11.xls

някой може ли да се опита да оправи втория код за създаване на под директориите?

naskobk · Ноември 1, 2014

Прилагам и втори вариант на файла,

тука всичко работи както трябва,

но се създават и празни директории,

възможно ли е да се избегне създаването на празните директории? auto_dir_1.0.xls

k0st4din · Ноември 2, 2014

Здравейте naskobk,

ако е това което си мисля, защото обяснението ви е от сорта "Аз си знам какво правя, а вие се сетете, какво искам", пробвайте следното:

Sub MkDirs()

Const RootPath = "C:\твоят\път"
Dim rng As Range

Set rng = Selection

For Each rw In rng.Rows
    ChDir RootPath
    For Each cl In rw.Cells
        If cl <> "" Then
            MkDir cl
            ChDir cl
        End If
    Next
Next 
End Sub

или

Sub CreateFolderStructure()    
    For Each objRow In UsedRange.Rows
        strFolders = "C:\myRootFolder"            
        For Each objCell In objRow.Cells
            strFolders = strFolders & "\" & objCell
        Next            
        Shell ("cmd /c md " & Chr(34) & strFolders & Chr(34))
    Next    
End Sub

Loop през всеки използван ред

Задайте главната папка, в която трябва да се създадат нашите нови папки. Трябва да се направи във всяка линия

Loop през всяка използвана клетка в текущия ред

Свързваме в главната папка с наклонена черта и нова под папка.
Направете това за всяка под папка в този ред, докато не се получи нещо като

"C:\myRootFolder\TOP FOLDER 1\SUB FOLDER 1.1\SUB FOLDER 1.2\SUB FOLDER 1.3"

Сега идва магията. Ние няма да използваме VBA в защитен режим.
Вместо това ние използваме Shell(cmd/c md), с който могат да се направят няколко папки с една команда. Той също така не произвежда грешка, ако вече съществува папка.

Няколко бележки

Избягвайте тези символи в имената на папките: © ® "- и" ^ () @

Празните Excel клетки не са проблем. Командата MD могат да се справят без проблем като

C:\root\\subfolder с две последователни наклонени черти

Spaces в имената на папките не са проблем, тъй като ние ги приключваме с пълната структура с две кавички (chr(34))

ето ви още един вариант при, който можете да си промените само редовете и колоните за да бъде отделно за всяка колона (А, В, С и т.н):

Sub CreateFolders()

Dim Cell As Range
Dim MyPath As String
Dim MyRange As Range

MyPath = ThisWorkbook.Sheets(1).Cells(2, 1)
Set MyRange = Range(Cells(3, 3), Cells(3, 3).End(xlDown))
   
For Each Cell In MyRange
    On Error Resume Next
    MkDir MyPath & "\" & Cell.Value
    If Err.Number > 0 Then
        Cell.Offset(0, 1).Value = "Some eror occurred"
    End If
Next Cell

End Sub

А що се отнася до каченият файл, нека примерите да бъдат отключени, не сме длъжни да "разбиваме" паролите.

naskobk · Ноември 2, 2014

Здрасти

k0st4din

Клетките съм ги заключил без парола просто избираш unlock cells и те се отключват,

vba кодирането може да го разгледаш на работещият файл,

благодаря за старанието.

Аз мислех дали ще може да се преработи този код:

Sub Make_Subfolders()
Dim LR As Long, cell As Range, rng As Range
With Sheets("Sheet1")
LR = .Range("b" & Rows.Count).End(xlUp).Row
For Each cell In .Range("b1:b12" & LR)
If cell.Value <> "" Then
If rng Is Nothing Then
Set rng = cell
Else
Set rng = Union(rng, cell)
End If
End If
Next cell
rng.Select
'Range("b1:b12").Select
Dim maxRows, maxCols, r, c As Integer
Set rng = Selection
maxRows = rng.Rows.Count
maxCols = rng.Columns.Count
For c = 1 To maxCols
r = 1
Do While r <= maxRows
If Len(Dir(ActiveWorkbook.Path & "\" & rng(r, c), vbDirectory)) = 0 Then
MkDir (ActiveWorkbook.Path & "\" & Range("A1").Value & "\" & rng(r, c))
ElseIf Range("A2").Value = "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A2").Value & "\" & rng(r, c))
ElseIf Range("A3").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A3").Value & "\" & rng(r, c))
ElseIf Range("A4").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A4").Value & "\" & rng(r, c))
ElseIf Range("A5").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A5").Value & "\" & rng(r, c))
ElseIf Range("A6").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A6").Value & "\" & rng(r, c))
ElseIf Range("A7").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A7").Value & "\" & rng(r, c))
ElseIf Range("A8").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A8").Value & "\" & rng(r, c))
ElseIf Range("A9").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A9").Value & "\" & rng(r, c))
ElseIf Range("A10").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A10").Value & "\" & rng(r, c))
ElseIf Range("A11").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A11").Value & "\" & rng(r, c))
ElseIf Range("A12").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A12").Value & "\" & rng(r, c))
Else:
On Error Resume Next
End If
r = r + 1
Loop
Next c
End With
End Sub

За мене е важно тази функция да присъства, "MkDir (ActiveWorkbook.Path" поради факта, че

където се намира изпълнимият файл, там трябва да създава директориите

и под директориите, не е нужно

да се указва пътя "C:\..\.."

така програмката става максимално автоматизирана,

въпроса ми беше как да избегна излишните папки, които се създават

без да даде грешка макроса, а пътя автоматично да се указва, спрямо това

къде се намира файла, или с други думи казано

програмата да прави това което прави в момента, без да създава

празна_папка_1,2,3.. и т.н.

просто създаването на тези празни_папки_1,2,3 и.т.н.

искам да го избегна,

трябва да се създават папки само които ги е указал потребителя

в синьото поле, другите папки да не се създават,

просто търся начин да избегна създаването на празни_папки 1,2,3 и.т.н.

това ми беше идеята................................

ето изпращам ти напълно отворен файл,

и скритите колони съм ги открил, за да видиш

как съм подходил...........

Благодаря за старанието, все пак

auto_dir_1.0_working.xls

Първият код го тествах работи, но с поддиректориите не се получава

Sub MkDirs()

Const RootPath = "C:\твоят\път"
Dim rng As Range

Set rng = Selection

For Each rw In rng.Rows
    ChDir RootPath
    For Each cl In rw.Cells
        If cl <> "" Then
            MkDir cl
            ChDir cl
        End If
    Next
Next
End Sub

ако може само да ми допишеш

към мойте макроси един макрос който да трие

така създадените Празни_папки_1,2,3, и т.н.

това също ще ме устройва............

naskobk · Ноември 2, 2014

Здрасти

k0st4din,

със този код почти се получи,

въпреки че алгоритъма е малко по

различен но все пак ме устройва,

Хиляди Благодарности за идеята..............

Sub CreateFolderStructure()
Const RootPath = "C:\proba"
Dim rng As Range

Set rng = Selection

    For Each objRow In rng.Rows
        strFolders = "C:\proba"
        For Each objCell In objRow.Cells
            strFolders = strFolders & "\" & objCell
        Next
        Shell ("cmd /c md " & Chr(34) & strFolders & Chr(34))
    Next
End Sub

naskobk · Ноември 2, 2014

Малко го промених,

твоя макрос, така работи по добре,

създава папки в текущата директория където се намира файла.

Sub CreateFolderStructure()
Range("k1:n12").Select
Dim rng As Range
Set rng = Selection
    For Each objRow In rng.Rows
        strFolders = Application.ActiveWorkbook.Path
        For Each objCell In objRow.Cells
            strFolders = strFolders & "\" & objCell
        Next
        Shell ("cmd /c md " & Chr(34) & strFolders & Chr(34))
    Next
    MsgBox "Done!"
Range("k1").Select
End Sub

Между другото макроса от второ ниво на таблицата която разработих,

и както гледам си дал запитване в екселски форум извън България,

работи, става дума за този макрос.........

Sub Make_Subfolders()
Dim LR As Long, cell As Range, rng As Range
    With Sheets("Sheet1")
        LR = .Range("b" & Rows.Count).End(xlUp).Row
        For Each cell In .Range("b1:b12" & LR)
            If cell.Value <> "" Then
                If rng Is Nothing Then
                    Set rng = cell
                Else
                    Set rng = Union(rng, cell)
                End If
            End If
        Next cell
        rng.Select
        'Range("b1:b12").Select
        Dim maxRows, maxCols, r, c As Integer
        Set rng = Selection
        maxRows = rng.Rows.Count
        maxCols = rng.Columns.Count
        For c = 1 To maxCols
            r = 1
            Do While r <= maxRows
                If Len(Dir(ActiveWorkbook.Path & "\" & rng(r, c), vbDirectory)) = 0 Then
                    MkDir (ActiveWorkbook.Path & "\" & Range("A1").Value & "\" & rng(r, c))
                End If
                If Range("A2").Value <> "" Then
                    MkDir (ActiveWorkbook.Path & "\" & Range("A2").Value & "\" & rng(r, c))
                End If
                If Range("A3").Value <> "" Then
                    MkDir (ActiveWorkbook.Path & "\" & Range("A3").Value & "\" & rng(r, c))
                End If
                If Range("A4").Value <> "" Then
                    MkDir (ActiveWorkbook.Path & "\" & Range("A4").Value & "\" & rng(r, c))
                End If
                If Range("A5").Value <> "" Then
                    MkDir (ActiveWorkbook.Path & "\" & Range("A5").Value & "\" & rng(r, c))
                End If
                If Range("A6").Value <> "" Then
                    MkDir (ActiveWorkbook.Path & "\" & Range("A6").Value & "\" & rng(r, c))
                End If
                If Range("A7").Value <> "" Then
                    MkDir (ActiveWorkbook.Path & "\" & Range("A7").Value & "\" & rng(r, c))
                End If
                If Range("A8").Value <> "" Then
                    MkDir (ActiveWorkbook.Path & "\" & Range("A8").Value & "\" & rng(r, c))
                End If
                If Range("A9").Value <> "" Then
                    MkDir (ActiveWorkbook.Path & "\" & Range("A9").Value & "\" & rng(r, c))
                End If
                If Range("A10").Value <> "" Then
                    MkDir (ActiveWorkbook.Path & "\" & Range("A10").Value & "\" & rng(r, c))
                End If
                If Range("A11").Value <> "" Then
                    MkDir (ActiveWorkbook.Path & "\" & Range("A11").Value & "\" & rng(r, c))
                End If
                If Range("A12").Value <> "" Then
                    MkDir (ActiveWorkbook.Path & "\" & Range("A12").Value & "\" & rng(r, c))
                End If
                r = r + 1
            Loop
        Next c    'Here give me error
    End With
End Sub

Грешка ти дава в 4ти ред на третия макрос:

само той трябва да се коригира и алгоритъма ще

сработи, за този макрос става въпрос:

Sub Make_Sub_folders()
Range("c1:c12").Select
Dim rng As Range
Dim maxRows, maxCols, r, c As Integer
Set rng = Selection
 maxRows = rng.Rows.Count
 maxCols = rng.Columns.Count
 For c = 1 To maxCols
 r = 1
 Do While r <= maxRows
 If Len(Dir(ActiveWorkbook.Path & "\" & rng(r, c), vbDirectory)) = 0 Then
MkDir (ActiveWorkbook.Path & "\" & Range("A1").Value & "\" & Range("b1").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A1").Value & "\" & Range("b2").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A1").Value & "\" & Range("b3").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A1").Value & "\" & Range("b4").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A1").Value & "\" & Range("b5").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A1").Value & "\" & Range("b6").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A1").Value & "\" & Range("b7").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A1").Value & "\" & Range("b8").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A1").Value & "\" & Range("b9").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A1").Value & "\" & Range("b10").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A1").Value & "\" & Range("b11").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A1").Value & "\" & Range("b12").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A2").Value & "\" & Range("b1").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A2").Value & "\" & Range("b2").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A2").Value & "\" & Range("b3").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A2").Value & "\" & Range("b4").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A2").Value & "\" & Range("b5").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A2").Value & "\" & Range("b6").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A2").Value & "\" & Range("b7").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A2").Value & "\" & Range("b8").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A2").Value & "\" & Range("b9").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A2").Value & "\" & Range("b10").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A2").Value & "\" & Range("b11").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A2").Value & "\" & Range("b12").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A3").Value & "\" & Range("b1").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A3").Value & "\" & Range("b2").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A3").Value & "\" & Range("b3").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A3").Value & "\" & Range("b4").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A3").Value & "\" & Range("b5").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A3").Value & "\" & Range("b6").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A3").Value & "\" & Range("b7").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A3").Value & "\" & Range("b8").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A3").Value & "\" & Range("b9").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A3").Value & "\" & Range("b10").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A3").Value & "\" & Range("b11").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A3").Value & "\" & Range("b12").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A4").Value & "\" & Range("b1").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A4").Value & "\" & Range("b2").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A4").Value & "\" & Range("b3").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A4").Value & "\" & Range("b4").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A4").Value & "\" & Range("b5").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A4").Value & "\" & Range("b6").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A4").Value & "\" & Range("b7").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A4").Value & "\" & Range("b8").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A4").Value & "\" & Range("b9").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A4").Value & "\" & Range("b10").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A4").Value & "\" & Range("b11").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A4").Value & "\" & Range("b12").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A5").Value & "\" & Range("b1").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A5").Value & "\" & Range("b2").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A5").Value & "\" & Range("b3").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A5").Value & "\" & Range("b4").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A5").Value & "\" & Range("b5").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A5").Value & "\" & Range("b6").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A5").Value & "\" & Range("b7").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A5").Value & "\" & Range("b8").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A5").Value & "\" & Range("b9").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A5").Value & "\" & Range("b10").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A5").Value & "\" & Range("b11").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A5").Value & "\" & Range("b12").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A6").Value & "\" & Range("b1").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A6").Value & "\" & Range("b2").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A6").Value & "\" & Range("b3").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A6").Value & "\" & Range("b4").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A6").Value & "\" & Range("b5").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A6").Value & "\" & Range("b6").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A6").Value & "\" & Range("b7").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A6").Value & "\" & Range("b8").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A6").Value & "\" & Range("b9").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A6").Value & "\" & Range("b10").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A6").Value & "\" & Range("b11").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A6").Value & "\" & Range("b12").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A7").Value & "\" & Range("b1").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A7").Value & "\" & Range("b2").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A7").Value & "\" & Range("b3").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A7").Value & "\" & Range("b4").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A7").Value & "\" & Range("b5").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A7").Value & "\" & Range("b6").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A7").Value & "\" & Range("b7").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A7").Value & "\" & Range("b8").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A7").Value & "\" & Range("b9").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A7").Value & "\" & Range("b10").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A7").Value & "\" & Range("b11").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A7").Value & "\" & Range("b12").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A8").Value & "\" & Range("b1").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A8").Value & "\" & Range("b2").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A8").Value & "\" & Range("b3").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A8").Value & "\" & Range("b4").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A8").Value & "\" & Range("b5").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A8").Value & "\" & Range("b6").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A8").Value & "\" & Range("b7").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A8").Value & "\" & Range("b8").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A8").Value & "\" & Range("b9").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A8").Value & "\" & Range("b10").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A8").Value & "\" & Range("b11").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A8").Value & "\" & Range("b12").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A9").Value & "\" & Range("b1").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A9").Value & "\" & Range("b2").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A9").Value & "\" & Range("b3").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A9").Value & "\" & Range("b4").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A9").Value & "\" & Range("b5").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A9").Value & "\" & Range("b6").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A9").Value & "\" & Range("b7").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A9").Value & "\" & Range("b8").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A9").Value & "\" & Range("b9").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A9").Value & "\" & Range("b10").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A9").Value & "\" & Range("b11").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A9").Value & "\" & Range("b12").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A10").Value & "\" & Range("b1").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A10").Value & "\" & Range("b2").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A10").Value & "\" & Range("b3").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A10").Value & "\" & Range("b4").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A10").Value & "\" & Range("b5").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A10").Value & "\" & Range("b6").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A10").Value & "\" & Range("b7").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A10").Value & "\" & Range("b8").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A10").Value & "\" & Range("b9").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A10").Value & "\" & Range("b10").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A10").Value & "\" & Range("b11").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A10").Value & "\" & Range("b12").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A11").Value & "\" & Range("b1").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A11").Value & "\" & Range("b2").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A11").Value & "\" & Range("b3").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A11").Value & "\" & Range("b4").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A11").Value & "\" & Range("b5").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A11").Value & "\" & Range("b6").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A11").Value & "\" & Range("b7").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A11").Value & "\" & Range("b8").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A11").Value & "\" & Range("b9").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A11").Value & "\" & Range("b10").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A11").Value & "\" & Range("b11").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A11").Value & "\" & Range("b12").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A12").Value & "\" & Range("b1").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A12").Value & "\" & Range("b2").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A12").Value & "\" & Range("b3").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A12").Value & "\" & Range("b4").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A12").Value & "\" & Range("b5").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A12").Value & "\" & Range("b6").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A12").Value & "\" & Range("b7").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A12").Value & "\" & Range("b8").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A12").Value & "\" & Range("b9").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A12").Value & "\" & Range("b10").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A12").Value & "\" & Range("b11").Value & "\" & rng(r, c))
MkDir (ActiveWorkbook.Path & "\" & Range("A12").Value & "\" & Range("b12").Value & "\" & rng(r, c))
On Error Resume Next
End If
r = r + 1
 Loop
Next c
 End Sub

k0st4din · Ноември 2, 2014

Да разбирам, че всичко е Ок след преработката стигаща до твоите нужди.

Поздрави

naskobk · Ноември 2, 2014

Здрасти k0st4din,

Прикачвам файла за да видиш какво се получи,

първи и втори алгоритъм работят,

трети алгоритъм работи но, създава празни клетки,

твоя вариант също съм го включил във файла

Лек ден ти желая и късмет..............

auto_dir_2.000000.xls

k0st4din · Ноември 3, 2014

Здравей,

кой точно макрос прави проблема, напиши ми името му:

Sub_Folder, Make_Sub_Folder....... или макроса от кой бутон в таблицата?

naskobk · Ноември 3, 2014

Здрасти k0st4din,

Бутона който съм го наименувал "Създай директория_3_ниво"

към него е прикачен макроса "Make_Level_3"

който представлява ето това

Sub Make_level_3()
MakeFolders
Make_Subfolders
Make_Sub_folders
MsgBox "Done!"
Range("a1").Select
End Sub

Или обединява три макроса, създават се папки с наименование

празна_папка_1,2,3

ако може да се избегне създаването на папки с наименование

празна_папка_1,2,3; тъй като после трябва да се трият ръчно.......

това е в общи линии - лек и спорен ден.......................................

k0st4din · Ноември 4, 2014

Да видим сега дали ще се получи, като смените вашият макрос с този:

(малко инфо)

Public Sub BuildFileList()
Dim fso As Object
Dim fldr As Object
Dim nextrow As Long
    
    Application.ScreenUpdating = False

    Set fso = CreateObject("Scripting.FilesystemObject")
    Set fldr = fso.GetFolder(Range("F1").Value)
    nextrow = 2
    Call GetFiles(fldr, nextrow)
    
    Columns("E:F").AutoFit
    
    Application.ScreenUpdating = True
End Sub

Private Function GetFiles(fldr As Object, nextrow As Long)
Dim file As Object
Dim subfolder As Object

    For Each file In fldr.Files
    
        nextrow = nextrow + 1
        Cells(nextrow, "E").Value = Replace(file.Path, "\" & file.Name, "")
        Cells(nextrow, "F").Value = Left$(file.Name, InStrRev(file.Name, ".") - 1)
    Next file
    
    nextrow = nextrow + 1
    For Each subfolder In fldr.subfolders
     
        Call GetFiles(subfolder, nextrow)        
    Next subfolder
End Function

или

Sub KOsta()

Dim xdir As String
Dim fso
Dim lstrow As Long
Dim i As Long
Dim j As Long
Set fso = CreateObject("Scripting.FileSystemObject")
lstrow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "D").End(xlUp).Row
Application.ScreenUpdating = False
For i = 1 To lstrow
For j = 1 To 4
xdir = "C:\Users\Twoqt\pyt\Do failyt\" _  'сменете пътя до вашите файлове
& Range("E" & i + 1).Value & "\" & Range("F" & j).Value
If Not fso.FolderExists(xdir) Then
fso.CreateFolder (xdir)
End If
Next j
Next i
Application.ScreenUpdating = True
End Sub

naskobk · Ноември 4, 2014

Здрасти k0st4din,

Всичко работи перфектно,

Благодаря за идеята,

Ето го целия код за програмката

който ми свърши перфектна работа.........

Sub MakeFolders()
Dim LR As Long, cell As Range, rng As Range
With Sheets("Sheet1")
    LR = .Range("a" & Rows.Count).End(xlUp).Row
    For Each cell In .Range("a1:a12" & LR)
        If cell.Value <> "" Then
            If rng Is Nothing Then
                Set rng = cell
            Else
                Set rng = Union(rng, cell)
            End If
        End If
    Next cell
    rng.Select
'Range("a1:a12").Select
Dim maxRows, maxCols, r, c As Integer
Set rng = Selection
 maxRows = rng.Rows.Count
 maxCols = rng.Columns.Count
 For c = 1 To maxCols
 r = 1
 Do While r <= maxRows
 If Len(Dir(ActiveWorkbook.Path & "\" & rng(r, c), vbDirectory)) = 0 Then
MkDir (ActiveWorkbook.Path & "\" & rng(r, c))
 On Error Resume Next
End If
r = r + 1
 Loop
Next c
End With
 End Sub
Sub Make_Subfolders()
Dim LR As Long, cell As Range, rng As Range
    With Sheets("Sheet1")
        LR = .Range("b" & Rows.Count).End(xlUp).Row
        For Each cell In .Range("b1:b12" & LR)
            If cell.Value <> "" Then
                If rng Is Nothing Then
                    Set rng = cell
                Else
                    Set rng = Union(rng, cell)
                End If
            End If
        Next cell
        rng.Select
        'Range("b1:b12").Select
        Dim maxRows, maxCols, r, c As Integer
        Set rng = Selection
        maxRows = rng.Rows.Count
        maxCols = rng.Columns.Count
        For c = 1 To maxCols
            r = 1
            Do While r <= maxRows
                If Len(Dir(ActiveWorkbook.Path & "\" & rng(r, c), vbDirectory)) = 0 Then
                    MkDir (ActiveWorkbook.Path & "\" & Range("A1").Value & "\" & rng(r, c))
                End If
                If Range("A2").Value <> "" Then
                    MkDir (ActiveWorkbook.Path & "\" & Range("A2").Value & "\" & rng(r, c))
                End If
                If Range("A3").Value <> "" Then
                    MkDir (ActiveWorkbook.Path & "\" & Range("A3").Value & "\" & rng(r, c))
                End If
                If Range("A4").Value <> "" Then
                    MkDir (ActiveWorkbook.Path & "\" & Range("A4").Value & "\" & rng(r, c))
                End If
                If Range("A5").Value <> "" Then
                    MkDir (ActiveWorkbook.Path & "\" & Range("A5").Value & "\" & rng(r, c))
                End If
                If Range("A6").Value <> "" Then
                    MkDir (ActiveWorkbook.Path & "\" & Range("A6").Value & "\" & rng(r, c))
                End If
                If Range("A7").Value <> "" Then
                    MkDir (ActiveWorkbook.Path & "\" & Range("A7").Value & "\" & rng(r, c))
                End If
                If Range("A8").Value <> "" Then
                    MkDir (ActiveWorkbook.Path & "\" & Range("A8").Value & "\" & rng(r, c))
                End If
                If Range("A9").Value <> "" Then
                    MkDir (ActiveWorkbook.Path & "\" & Range("A9").Value & "\" & rng(r, c))
                End If
                If Range("A10").Value <> "" Then
                    MkDir (ActiveWorkbook.Path & "\" & Range("A10").Value & "\" & rng(r, c))
                End If
                If Range("A11").Value <> "" Then
                    MkDir (ActiveWorkbook.Path & "\" & Range("A11").Value & "\" & rng(r, c))
                End If
                If Range("A12").Value <> "" Then
                    MkDir (ActiveWorkbook.Path & "\" & Range("A12").Value & "\" & rng(r, c))
                End If
                r = r + 1
            Loop
        Next c    'Here give me error
    End With

End Sub
 Sub Make_Sub_folders()
Dim LR As Long, cell As Range, rng As Range
    With Sheets("Sheet1")
        LR = .Range("c" & Rows.Count).End(xlUp).Row
        For Each cell In .Range("c1:c12" & LR)
            If cell.Value <> "" Then
                If rng Is Nothing Then
                    Set rng = cell
                Else
                    Set rng = Union(rng, cell)
                End If
            End If
        Next cell
        rng.Select
        'Range("b1:b12").Select
        Dim maxRows, maxCols, r, c As Integer
        Set rng = Selection
        maxRows = rng.Rows.Count
        maxCols = rng.Columns.Count
        For c = 1 To maxCols
            r = 1
            Do While r <= maxRows
 If Len(Dir(ActiveWorkbook.Path & "\" & rng(r, c), vbDirectory)) = 0 Then
MkDir (ActiveWorkbook.Path & "\" & Range("A1").Value & "\" & Range("b1").Value & "\" & rng(r, c))
End If
If Range("a2").Value <> "" And Range("b1").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A2").Value & "\" & Range("b1").Value & "\" & rng(r, c))
End If
If Range("a3").Value <> "" And Range("b1").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A3").Value & "\" & Range("b1").Value & "\" & rng(r, c))
End If
If Range("a4").Value <> "" And Range("b1").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A4").Value & "\" & Range("b1").Value & "\" & rng(r, c))
End If
If Range("a5").Value <> "" And Range("b1").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A5").Value & "\" & Range("b1").Value & "\" & rng(r, c))
End If
If Range("a6").Value <> "" And Range("b1").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A6").Value & "\" & Range("b1").Value & "\" & rng(r, c))
End If
If Range("a7").Value <> "" And Range("b1").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A7").Value & "\" & Range("b1").Value & "\" & rng(r, c))
End If
If Range("a8").Value <> "" And Range("b1").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A8").Value & "\" & Range("b1").Value & "\" & rng(r, c))
End If
If Range("a9").Value <> "" And Range("b1").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A9").Value & "\" & Range("b1").Value & "\" & rng(r, c))
End If
If Range("a10").Value <> "" And Range("b1").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A10").Value & "\" & Range("b1").Value & "\" & rng(r, c))
End If
If Range("a11").Value <> "" And Range("b1").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A11").Value & "\" & Range("b1").Value & "\" & rng(r, c))
End If
If Range("a12").Value <> "" And Range("b1").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A12").Value & "\" & Range("b1").Value & "\" & rng(r, c))
End If
If Range("a1").Value <> "" And Range("b2").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A1").Value & "\" & Range("b2").Value & "\" & rng(r, c))
End If
If Range("a2").Value <> "" And Range("b2").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A2").Value & "\" & Range("b2").Value & "\" & rng(r, c))
End If
If Range("a3").Value <> "" And Range("b2").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A3").Value & "\" & Range("b2").Value & "\" & rng(r, c))
End If
If Range("a4").Value <> "" And Range("b2").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A4").Value & "\" & Range("b2").Value & "\" & rng(r, c))
End If
If Range("a5").Value <> "" And Range("b2").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A5").Value & "\" & Range("b2").Value & "\" & rng(r, c))
End If
If Range("a6").Value <> "" And Range("b2").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A6").Value & "\" & Range("b2").Value & "\" & rng(r, c))
End If
If Range("a7").Value <> "" And Range("b2").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A7").Value & "\" & Range("b2").Value & "\" & rng(r, c))
End If
If Range("a8").Value <> "" And Range("b2").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A8").Value & "\" & Range("b2").Value & "\" & rng(r, c))
End If
If Range("a9").Value <> "" And Range("b2").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A9").Value & "\" & Range("b2").Value & "\" & rng(r, c))
End If
If Range("a10").Value <> "" And Range("b2").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A10").Value & "\" & Range("b2").Value & "\" & rng(r, c))
End If
If Range("a11").Value <> "" And Range("b2").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A11").Value & "\" & Range("b2").Value & "\" & rng(r, c))
End If
If Range("a12").Value <> "" And Range("b2").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A12").Value & "\" & Range("b2").Value & "\" & rng(r, c))
End If
If Range("a1").Value <> "" And Range("b3").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A1").Value & "\" & Range("b3").Value & "\" & rng(r, c))
End If
If Range("a2").Value <> "" And Range("b3").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A2").Value & "\" & Range("b3").Value & "\" & rng(r, c))
End If
If Range("a3").Value <> "" And Range("b3").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A3").Value & "\" & Range("b3").Value & "\" & rng(r, c))
End If
If Range("a4").Value <> "" And Range("b3").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A4").Value & "\" & Range("b3").Value & "\" & rng(r, c))
End If
If Range("a5").Value <> "" And Range("b3").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A5").Value & "\" & Range("b3").Value & "\" & rng(r, c))
End If
If Range("a6").Value <> "" And Range("b3").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A6").Value & "\" & Range("b3").Value & "\" & rng(r, c))
End If
If Range("a7").Value <> "" And Range("b3").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A7").Value & "\" & Range("b3").Value & "\" & rng(r, c))
End If
If Range("a8").Value <> "" And Range("b3").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A8").Value & "\" & Range("b3").Value & "\" & rng(r, c))
End If
If Range("a9").Value <> "" And Range("b3").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A9").Value & "\" & Range("b3").Value & "\" & rng(r, c))
End If
If Range("a10").Value <> "" And Range("b3").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A10").Value & "\" & Range("b3").Value & "\" & rng(r, c))
End If
If Range("a11").Value <> "" And Range("b3").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A11").Value & "\" & Range("b3").Value & "\" & rng(r, c))
End If
If Range("a12").Value <> "" And Range("b3").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A12").Value & "\" & Range("b3").Value & "\" & rng(r, c))
End If
If Range("a1").Value <> "" And Range("b4").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A1").Value & "\" & Range("b4").Value & "\" & rng(r, c))
End If
If Range("a2").Value <> "" And Range("b4").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A2").Value & "\" & Range("b4").Value & "\" & rng(r, c))
End If
If Range("a3").Value <> "" And Range("b4").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A3").Value & "\" & Range("b4").Value & "\" & rng(r, c))
End If
If Range("a4").Value <> "" And Range("b4").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A4").Value & "\" & Range("b4").Value & "\" & rng(r, c))
End If
If Range("a5").Value <> "" And Range("b4").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A5").Value & "\" & Range("b4").Value & "\" & rng(r, c))
End If
If Range("a6").Value <> "" And Range("b4").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A6").Value & "\" & Range("b4").Value & "\" & rng(r, c))
End If
If Range("a7").Value <> "" And Range("b4").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A7").Value & "\" & Range("b4").Value & "\" & rng(r, c))
End If
If Range("a8").Value <> "" And Range("b4").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A8").Value & "\" & Range("b4").Value & "\" & rng(r, c))
End If
If Range("a9").Value <> "" And Range("b4").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A9").Value & "\" & Range("b4").Value & "\" & rng(r, c))
End If
If Range("a10").Value <> "" And Range("b4").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A10").Value & "\" & Range("b4").Value & "\" & rng(r, c))
End If
If Range("a11").Value <> "" And Range("b4").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A11").Value & "\" & Range("b4").Value & "\" & rng(r, c))
End If
If Range("a12").Value <> "" And Range("b4").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A12").Value & "\" & Range("b4").Value & "\" & rng(r, c))
End If
If Range("a1").Value <> "" And Range("b5").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A1").Value & "\" & Range("b5").Value & "\" & rng(r, c))
End If
If Range("a2").Value <> "" And Range("b5").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A2").Value & "\" & Range("b5").Value & "\" & rng(r, c))
End If
If Range("a3").Value <> "" And Range("b5").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A3").Value & "\" & Range("b5").Value & "\" & rng(r, c))
End If
If Range("a4").Value <> "" And Range("b5").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A4").Value & "\" & Range("b5").Value & "\" & rng(r, c))
End If
If Range("a5").Value <> "" And Range("b5").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A5").Value & "\" & Range("b5").Value & "\" & rng(r, c))
End If
If Range("a6").Value <> "" And Range("b5").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A6").Value & "\" & Range("b5").Value & "\" & rng(r, c))
End If
If Range("a7").Value <> "" And Range("b5").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A7").Value & "\" & Range("b5").Value & "\" & rng(r, c))
End If
If Range("a8").Value <> "" And Range("b5").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A8").Value & "\" & Range("b5").Value & "\" & rng(r, c))
End If
If Range("a9").Value <> "" And Range("b5").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A9").Value & "\" & Range("b5").Value & "\" & rng(r, c))
End If
If Range("a10").Value <> "" And Range("b5").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A10").Value & "\" & Range("b5").Value & "\" & rng(r, c))
End If
If Range("a11").Value <> "" And Range("b5").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A11").Value & "\" & Range("b5").Value & "\" & rng(r, c))
End If
If Range("a12").Value <> "" And Range("b5").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A12").Value & "\" & Range("b5").Value & "\" & rng(r, c))
End If
If Range("a1").Value <> "" And Range("b6").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A1").Value & "\" & Range("b6").Value & "\" & rng(r, c))
End If
If Range("a2").Value <> "" And Range("b6").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A2").Value & "\" & Range("b6").Value & "\" & rng(r, c))
End If
If Range("a3").Value <> "" And Range("b6").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A3").Value & "\" & Range("b6").Value & "\" & rng(r, c))
End If
If Range("a4").Value <> "" And Range("b6").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A4").Value & "\" & Range("b6").Value & "\" & rng(r, c))
End If
If Range("a5").Value <> "" And Range("b6").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A5").Value & "\" & Range("b6").Value & "\" & rng(r, c))
End If
If Range("a6").Value <> "" And Range("b6").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A6").Value & "\" & Range("b6").Value & "\" & rng(r, c))
End If
If Range("a7").Value <> "" And Range("b6").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A7").Value & "\" & Range("b6").Value & "\" & rng(r, c))
End If
If Range("a8").Value <> "" And Range("b6").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A8").Value & "\" & Range("b6").Value & "\" & rng(r, c))
End If
If Range("a9").Value <> "" And Range("b6").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A9").Value & "\" & Range("b6").Value & "\" & rng(r, c))
End If
If Range("a10").Value <> "" And Range("b6").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A10").Value & "\" & Range("b6").Value & "\" & rng(r, c))
End If
If Range("a11").Value <> "" And Range("b6").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A11").Value & "\" & Range("b6").Value & "\" & rng(r, c))
End If
If Range("a12").Value <> "" And Range("b6").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A12").Value & "\" & Range("b6").Value & "\" & rng(r, c))
End If
If Range("a1").Value <> "" And Range("b7").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A1").Value & "\" & Range("b7").Value & "\" & rng(r, c))
End If
If Range("a2").Value <> "" And Range("b7").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A2").Value & "\" & Range("b7").Value & "\" & rng(r, c))
End If
If Range("a3").Value <> "" And Range("b7").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A3").Value & "\" & Range("b7").Value & "\" & rng(r, c))
End If
If Range("a4").Value <> "" And Range("b7").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A4").Value & "\" & Range("b7").Value & "\" & rng(r, c))
End If
If Range("a5").Value <> "" And Range("b7").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A5").Value & "\" & Range("b7").Value & "\" & rng(r, c))
End If
If Range("a6").Value <> "" And Range("b7").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A6").Value & "\" & Range("b7").Value & "\" & rng(r, c))
End If
If Range("a7").Value <> "" And Range("b7").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A7").Value & "\" & Range("b7").Value & "\" & rng(r, c))
End If
If Range("a8").Value <> "" And Range("b7").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A8").Value & "\" & Range("b7").Value & "\" & rng(r, c))
End If
If Range("a9").Value <> "" And Range("b7").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A9").Value & "\" & Range("b7").Value & "\" & rng(r, c))
End If
If Range("a10").Value <> "" And Range("b7").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A10").Value & "\" & Range("b7").Value & "\" & rng(r, c))
End If
If Range("a11").Value <> "" And Range("b7").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A11").Value & "\" & Range("b7").Value & "\" & rng(r, c))
End If
If Range("a12").Value <> "" And Range("b7").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A12").Value & "\" & Range("b7").Value & "\" & rng(r, c))
End If
If Range("a1").Value <> "" And Range("b8").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A1").Value & "\" & Range("b8").Value & "\" & rng(r, c))
End If
If Range("a2").Value <> "" And Range("b8").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A2").Value & "\" & Range("b8").Value & "\" & rng(r, c))
End If
If Range("a3").Value <> "" And Range("b8").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A3").Value & "\" & Range("b8").Value & "\" & rng(r, c))
End If
If Range("a4").Value <> "" And Range("b8").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A4").Value & "\" & Range("b8").Value & "\" & rng(r, c))
End If
If Range("a5").Value <> "" And Range("b8").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A5").Value & "\" & Range("b8").Value & "\" & rng(r, c))
End If
If Range("a6").Value <> "" And Range("b8").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A6").Value & "\" & Range("b8").Value & "\" & rng(r, c))
End If
If Range("a7").Value <> "" And Range("b8").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A7").Value & "\" & Range("b8").Value & "\" & rng(r, c))
End If
If Range("a8").Value <> "" And Range("b8").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A8").Value & "\" & Range("b8").Value & "\" & rng(r, c))
End If
If Range("a9").Value <> "" And Range("b8").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A9").Value & "\" & Range("b8").Value & "\" & rng(r, c))
End If
If Range("a10").Value <> "" And Range("b8").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A10").Value & "\" & Range("b8").Value & "\" & rng(r, c))
End If
If Range("a11").Value <> "" And Range("b8").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A11").Value & "\" & Range("b8").Value & "\" & rng(r, c))
End If
If Range("a12").Value <> "" And Range("b8").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A12").Value & "\" & Range("b8").Value & "\" & rng(r, c))
End If
If Range("a1").Value <> "" And Range("b9").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A1").Value & "\" & Range("b9").Value & "\" & rng(r, c))
End If
If Range("a2").Value <> "" And Range("b10").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A2").Value & "\" & Range("b9").Value & "\" & rng(r, c))
End If
If Range("a3").Value <> "" And Range("b9").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A3").Value & "\" & Range("b9").Value & "\" & rng(r, c))
End If
If Range("a4").Value <> "" And Range("b9").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A4").Value & "\" & Range("b9").Value & "\" & rng(r, c))
End If
If Range("a5").Value <> "" And Range("b9").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A5").Value & "\" & Range("b9").Value & "\" & rng(r, c))
End If
If Range("a6").Value <> "" And Range("b9").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A6").Value & "\" & Range("b9").Value & "\" & rng(r, c))
End If
If Range("a7").Value <> "" And Range("b9").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A7").Value & "\" & Range("b9").Value & "\" & rng(r, c))
End If
If Range("a8").Value <> "" And Range("b9").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A8").Value & "\" & Range("b9").Value & "\" & rng(r, c))
End If
If Range("a9").Value <> "" And Range("b9").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A9").Value & "\" & Range("b9").Value & "\" & rng(r, c))
End If
If Range("a10").Value <> "" And Range("b9").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A10").Value & "\" & Range("b9").Value & "\" & rng(r, c))
End If
If Range("a11").Value <> "" And Range("b9").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A11").Value & "\" & Range("b9").Value & "\" & rng(r, c))
End If
If Range("a12").Value <> "" And Range("b9").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A12").Value & "\" & Range("b9").Value & "\" & rng(r, c))
End If
If Range("a1").Value <> "" And Range("b10").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A1").Value & "\" & Range("b10").Value & "\" & rng(r, c))
End If
If Range("a2").Value <> "" And Range("b10").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A2").Value & "\" & Range("b10").Value & "\" & rng(r, c))
End If
If Range("a3").Value <> "" And Range("b10").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A3").Value & "\" & Range("b10").Value & "\" & rng(r, c))
End If
If Range("a4").Value <> "" And Range("b10").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A4").Value & "\" & Range("b10").Value & "\" & rng(r, c))
End If
If Range("a5").Value <> "" And Range("b10").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A5").Value & "\" & Range("b10").Value & "\" & rng(r, c))
End If
If Range("a6").Value <> "" And Range("b10").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A6").Value & "\" & Range("b10").Value & "\" & rng(r, c))
End If
If Range("a7").Value <> "" And Range("b10").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A7").Value & "\" & Range("b10").Value & "\" & rng(r, c))
End If
If Range("a8").Value <> "" And Range("b10").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A8").Value & "\" & Range("b10").Value & "\" & rng(r, c))
End If
If Range("a9").Value <> "" And Range("b10").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A9").Value & "\" & Range("b10").Value & "\" & rng(r, c))
End If
If Range("a10").Value <> "" And Range("b10").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A10").Value & "\" & Range("b10").Value & "\" & rng(r, c))
End If
If Range("a11").Value <> "" And Range("b10").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A11").Value & "\" & Range("b10").Value & "\" & rng(r, c))
End If
If Range("a1").Value <> "" And Range("b11").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A1").Value & "\" & Range("b11").Value & "\" & rng(r, c))
End If
If Range("a2").Value <> "" And Range("b11").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A2").Value & "\" & Range("b11").Value & "\" & rng(r, c))
End If
If Range("a3").Value <> "" And Range("b11").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A3").Value & "\" & Range("b11").Value & "\" & rng(r, c))
End If
If Range("a4").Value <> "" And Range("b11").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A4").Value & "\" & Range("b11").Value & "\" & rng(r, c))
End If
If Range("a5").Value <> "" And Range("b11").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A5").Value & "\" & Range("b11").Value & "\" & rng(r, c))
End If
If Range("a6").Value <> "" And Range("b11").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A6").Value & "\" & Range("b11").Value & "\" & rng(r, c))
End If
If Range("a7").Value <> "" And Range("b11").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A7").Value & "\" & Range("b11").Value & "\" & rng(r, c))
End If
If Range("a8").Value <> "" And Range("b11").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A8").Value & "\" & Range("b11").Value & "\" & rng(r, c))
End If
If Range("a9").Value <> "" And Range("b11").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A9").Value & "\" & Range("b11").Value & "\" & rng(r, c))
End If
If Range("a10").Value <> "" And Range("b11").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A10").Value & "\" & Range("b11").Value & "\" & rng(r, c))
End If
If Range("a11").Value <> "" And Range("b11").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A11").Value & "\" & Range("b11").Value & "\" & rng(r, c))
End If
If Range("a12").Value <> "" And Range("b11").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A12").Value & "\" & Range("b11").Value & "\" & rng(r, c))
End If
If Range("a1").Value <> "" And Range("b12").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A1").Value & "\" & Range("b12").Value & "\" & rng(r, c))
End If
If Range("a2").Value <> "" And Range("b12").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A2").Value & "\" & Range("b12").Value & "\" & rng(r, c))
End If
If Range("a3").Value <> "" And Range("b12").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A3").Value & "\" & Range("b12").Value & "\" & rng(r, c))
End If
If Range("a4").Value <> "" And Range("b12").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A4").Value & "\" & Range("b12").Value & "\" & rng(r, c))
End If
If Range("a5").Value <> "" And Range("b12").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A5").Value & "\" & Range("b12").Value & "\" & rng(r, c))
End If
If Range("a6").Value <> "" And Range("b12").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A6").Value & "\" & Range("b12").Value & "\" & rng(r, c))
End If
If Range("a7").Value <> "" And Range("b12").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A7").Value & "\" & Range("b12").Value & "\" & rng(r, c))
End If
If Range("a8").Value <> "" And Range("b12").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A8").Value & "\" & Range("b12").Value & "\" & rng(r, c))
End If
If Range("a9").Value <> "" And Range("b12").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A9").Value & "\" & Range("b12").Value & "\" & rng(r, c))
End If
If Range("a10").Value <> "" And Range("b12").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A10").Value & "\" & Range("b12").Value & "\" & rng(r, c))
End If
If Range("a11").Value <> "" And Range("b12").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A11").Value & "\" & Range("b12").Value & "\" & rng(r, c))
End If
If Range("a12").Value <> "" And Range("b12").Value <> "" Then
MkDir (ActiveWorkbook.Path & "\" & Range("A12").Value & "\" & Range("b12").Value & "\" & rng(r, c))
End If
                r = r + 1
            Loop
        Next c    'Here give me error
    End With

End Sub
 
Sub Make_level_3()
MakeFolders
Make_Subfolders
Make_Sub_folders
MsgBox "Done!"
Range("a1").Select
End Sub

Sub Make_level_2()
MakeFolders
Make_Subfolders
MsgBox "Done!"
Range("a1").Select
End Sub

Sub Make_level_1()
MakeFolders
MsgBox "Done!"
Range("a1").Select
End Sub

Sub CreateFolderStructure()
Range("g1:j12").Select
Dim rng As Range

Set rng = Selection


    For Each objRow In rng.Rows
        strFolders = Application.ActiveWorkbook.Path
        For Each objCell In objRow.Cells
            strFolders = strFolders & "\" & objCell
        Next
        Shell ("cmd /c md " & Chr(34) & strFolders & Chr(34))
    Next
    MsgBox "Done!"
Range("g1").Select
End Sub

Благодаря за старанието,

възползвах се от някой твой идеи

Поздрави и късмет.....................................

Ръководства за работа с Excel 2003

Препоръчан пост

Link to comment

Сподели другаде

ТОП потребители в тази тема

Популярни дни

ТОП потребители в тази тема

Популярни дни

Публикувани изображения

Link to comment

Сподели другаде

Link to comment

Сподели другаде

Link to comment

Сподели другаде

Link to comment

Сподели другаде

Link to comment

Сподели другаде

Link to comment

Сподели другаде

Link to comment

Сподели другаде

Link to comment

Сподели другаде

Link to comment

Сподели другаде

Link to comment

Сподели другаде

Link to comment

Сподели другаде

Link to comment

Сподели другаде

Link to comment

Сподели другаде

Link to comment

Сподели другаде