Soru KOŞULLARA GÖRE KLASÖR OLUŞTURMA

[sjanaz55]

Merhaba,

ekteki dosyada oluşturmak istediğim klasör dizininin planı bulunmakta.
bu tabloyu makro ile buraya getirebiliyorum fakat sonrasındaki klasör oluşturma denemelerim sonuç vermedi. forumda birçok konuyu araştırdım ancak bu formata uyduramadım.

şuan mevcut verilerin güncellemesi devam ediyor bittiğinde bu tabloyu son kez sistemden çekip klasör sistemini kurunca devreye alacağım

A sütunundaki veriler üst klasörler
B sütunu ve sağa doğru olan veriler de üst klasörlerin içinde bulunacak.

üst klasör ve alt klasör verileri değişiklik gösterecek. tahminime göre üst klasör sayısı 70 lerin üzerine çıkabilir. alt klasörlerde ise 2000 civarı olmasını bekliyorum
bir de her açılan alt klasörde "_TEKNİKRESİM" adında bir klasör daha oluşturmak istiyorum

tavsiye ve yardımlarınızı bekliyorum

teşekkürler

 

[bmutlu966]

Deneyiniz.

Sub Klasör_Olustur()

Dim c

On Error Resume Next

Set c = CreateObject("Scripting.FileSystemObject")

For f = 2 To 11 'B-L kolonlari arasi
    c.CreateFolder "C:\" & Cells(2, f) '2. satırda yazan ana klasorleri C: nin altina acar
  
    son = Cells(65000, f).End(3).Row
  
    For t = 3 To son
        c.CreateFolder "C:\" & Cells(2, f) & "\" & Cells(t, f) 'ana klasorlerin altindaki klasorleri acar
        c.CreateFolder "C:\" & Cells(2, f) & "\" & Cells(t, f) & "\" & "_TEKNIKRESIM"
    Next

Next

End Sub

 

[sjanaz55]

Deneyiniz.

Sub Klasör_Olustur()

Dim c

On Error Resume Next

Set c = CreateObject("Scripting.FileSystemObject")

For f = 2 To 11 'B-L kolonlari arasi
    c.CreateFolder "C:\" & Cells(2, f) '2. satırda yazan ana klasorleri C: nin altina acar
 
    son = Cells(65000, f).End(3).Row
 
    For t = 3 To son
        c.CreateFolder "C:\" & Cells(2, f) & "\" & Cells(t, f) 'ana klasorlerin altindaki klasorleri acar
        c.CreateFolder "C:\" & Cells(2, f) & "\" & Cells(t, f) & "\" & "_TEKNIKRESIM"
    Next

Next

End Sub

çok teşekkür ederim işimi gördü
elinize sağlık