1. in fisierul atasat de tine celula A1 contine un "prefix" si este scris doar acolo,
2. in C1 ai un "sufix" si apare o singura data
3. pe coloana B ai scris numele folderelor ce ar trebui create
4. pe coloana G ai datele calendaristice pentru care trebuie create subfoldere
adaugand suplimentar, cel putin pentru testele pe care le-am facut un folder "Radacina" care trebuie sa existe ca subfolder acolo unde vei pune fisierul cu codul atasat, ar trebui ca urmatorul cod sa faca treaba cu o conditie suplimentara - NU trebuie sa existe caractere invalide sau mai exact nepermise in denumirea unui folder, pentru ca acest cod nu face verificari suplimentare.
Asa ca testeaza codul de mai jos:
Cod: Selectaţi tot
Sub CreareFoldere()
Dim Prefix As String, NumeFolder As String, Sufix As String
Dim cFolder As String, cData As String
Dim nFolder As Double, nData As Double
Dim Cale As String
'seteaza parametrii initiali
Cale = ThisWorkbook.Path & "\Radacina\"
Prefix = Range("A1").Value
Sufix = Range("C1").Value
cFolder = "B" 'Coloana de unde citeste folderele
cData = "G" 'Coloana de unde citeste datele - trebuie sa contina date calendaristice nu text
'Detecteaza cate randuri sunt de parcurs pe coloanele cFolder si cData
nFolder = ActiveSheet.Cells(ActiveSheet.Rows.Count, cFolder).End(xlUp).Row
nData = ActiveSheet.Cells(ActiveSheet.Rows.Count, cData).End(xlUp).Row
'Creeaza folderele
For i = 1 To nFolder
NumeFolder = Prefix & Range(cFolder & i).Value & Sufix
MkDir (Cale & NumeFolder)
For j = 1 To nData
MkDir (Cale & NumeFolder & "\" & Format(Range(cData & j).Value, "dd-mm-yyyy"))
Next j
Next i
End Sub