Snel mappen maken d.m.v. Excel

[sergiodissel]

Hallo,

Ik heb een Excel-bestand met adressen en zou graag voor elk adres een apart mapje willen maken. Dit gaat natuurlijk erg lang duren als dit met de hand gedaan wordt, ik vroeg mij daarom af of er een code is die dat doet. In kolom F staat de straat, in kolom G staat vanaf welk huisnummer en in kolom H staat tot welk huisnummer. Naam van mapje zou dan bijv. er zo uitzien: "Teststraat 1 - 3".

Met deze code krijg ik wel al mapjes van de verschillende straten:

Sub MakeDirs()
Dim MyRange As String
MyRange = Range("AM3")
Dim vFolderList As Variant, i As Long
vFolderList = Range("F3:F" & Cells(Rows.Count, "F").End(xlUp).Row).Value
On Error Resume Next
For i = 1 To UBound(vFolderList, 1)
    MkDir MyRange & vFolderList(i, 1)  'amend the directory as required (it must exist)
Next
End Sub

 

[wampier]

afhankelijk van hoe de data geformatteerd is in kolom G kun je die er op dezelfde manier toch achterplakken?

MkDir MyRange & vFolderList(i, 1) &  vFolderList(i, 1).offset(0,1)

 

[sergiodissel]

Heb het erachter geplakt, maar nog steeds alleen de straatnaam. Zou dit misschien fout kunnen hebben gedaan, eerste keer dat ik met zo'n code werk

 

[wampier]

oeps zie nu ook net dat je ook kolom H nodig hebt

Probeer eens:

msgbox MyRange & vFolderList(i, 1) &  vFolderList(i, 1).offset(0,1) & vFolderList(i, 1).offset(0,2)

LET OP even het aantal items beperken omdat je er doorheen moet klikken! (3-4 items bijvoorbeeld eventueel in apart werkboek doen). deze code maakt verder geen directories maar laat zien wat er naar het commando gaat

Anders even een klein bestandje toevoegen zodat we kunnen zien hoe de data eruit ziet

 

[sergiodissel]

Kom er zelf niet echt uit...

Heb even een gedeelte van het bestand bijgevoegd
Bekijk bijlage TEST.xlsx

 

[VenA]

Zo beter?

Sub MakeDirs()
Dim MyRange As String
MyRange = Range("AM3")
Dim vFolderList As Variant, i As Long
vFolderList = Range("F3:F" & Cells(Rows.Count, "F").End(xlUp).Row).Resize(, 3).Value
On Error Resume Next
For i = 1 To UBound(vFolderList, 1)
    MkDir MyRange & vFolderList(i, 1) & " " & vFolderList(i, 2) & " - " & vFolderList(i, 3) 'amend the directory as required (it must exist)
Next
End Sub

 

[sergiodissel]

Perfect het werkt zo!