Automatisch meerdere bestanden opslaan volgens namen uit celwaarden

[Jap3600]

Hallo,

Ik ben al even bezig maar kom hier zelf niet uit.
Wat ik wil is het volgende.

In heb een excelbestand met daarin diversen tabbladen.
Wat ik wil bereiken is dat hij vanuit tabblad "Benamingen" bestanden gaat creëren die daar staan vermeld in een lijst.
Bij mijn voorbeeld zijn dat er 6.
Deze namen wil ik laten overnemen in het tabblad "Invulblad" waarna het bestand het bestand dient op te slaan in de map
C:\Users\Gebruiker\Documents\Noren\Bestanden\
Hierna hetzelfde met de 2e naam en zo door tot alle namen zijn geweest die in kolom D3 tot en met D8 staan. (Mijn lijst is ongeveer 190 items welke opgeslagen dienen te worden....)

Weet iemand hier een oplossing voor??
Ter verduidelijking heb ik even een klein voorbeeldje toegevoegd.

Bekijk bijlage Test_OPSLAAN_01.xlsm

 

[HSV]

Is dit iets?

Sub hsv()
Dim cl As Range
For Each cl In Sheets("benamingen").[d3:d8]
  Sheets("invulblad").[B3] = cl
  ThisWorkbook.SaveCopyAs "C:\Users\Gebruiker\Documents\Noren\Bestanden\" & cl.Value & ".xlsm"
Next cl
End Sub

 

[Jap3600]

Is dit iets?

Sub hsv()
Dim cl As Range
For Each cl In Sheets("benamingen").[d3:d8]
  Sheets("invulblad").[B3] = cl
  ThisWorkbook.SaveCopyAs "C:\Users\Gebruiker\Documents\Noren\Bestanden\" & cl.Value & ".xlsm"
Next cl
End Sub

Beste Harry,

Ik sta versteld.... Ziet er wederom weer zo simpel uit maar niets is minder waar..

Heb nog een bijkomende vraag die misschien ook mogelijk is.
De bestanden worden nu netjes gemaakt volgens uw code "C:\Users\Gebruiker\Documents\Noren\Bestanden" & cl.Value & ".xlsm"
Echter zou het handig zijn als er ook een map wordt aangemaakt volgens de cl.Value naam en vervolgens het bestand daarin geplaatst kan worden.

"C:\Users\Gebruiker\Documents\Noren\Bestanden" & cl.Value "" & cl.Value & ".xlsm"

Heb onderstaande code waardoor mappen al aangemaakt worden volgens een lijst die ik eerst in een ander bestand kopieer in de kolom A
Zie hieronder die code

Sub MakeDirs()
Dim MyRange As String
MyRange = Range("C1")
Dim vFolderList As Variant, i As Long
vFolderList = Range("A1:A" & Cells(Rows.Count, "A").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

Natuurlijk weet ik niet of dat dit zomaar mogelijk is en of deze code's gecombineerd kunnen worden.....
Anders moet ik ze even in de mappen slepen..

 

[Jap3600]

Beste allemaal.

Inmiddels is het me gelukt... :thumb: