|
ベタ書きですが、概ねこんな感じです。"C:\" のところは任意に変更して下さい。
Cells(4, 3)からということなので、C4 からC列最終入力行までとしています。
Sub Make_MyFol()
Dim FSO As Object, WS As Worksheet, C As Range
Dim Sf1 As String, Sf2 As String, Sf3 As String
Dim i As Integer
Set FSO = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
For Each WS In Sheets(Array("新", "旧"))
FSO.CreateFolder "C:\" & WS.Name
For Each C In WS.Range("C4", WS.Range("C65536").End(xlUp))
Sf1 = "C:\" & WS.Name & "\" & C.Value
If FSO.FolderExists(Sf1) = False Then
FSO.CreateFolder Sf1
End If
Sf2 = Sf1 & "\" & C.Offset(, 1).Value
FSO.CreateFolder Sf2
For i = 1 To C.Offset(, 2).Value
Sf3 = Sf2 & "\" & i
FSO.CreateFolder Sf3
Next i
Next
Next WS
Set FSO = Nothing
End Sub
|
|