Via macro's Excel nieuwe bestanden aan laten maken?

[Basz123]

Goedemiddag iedereen,

Voor mijn werk ben ik aan het kijken of ik een macro in een bepaald Excel document kan bouwen die automatisch nieuwe Excel documenten aanmaakt.

Bijvoorbeeld; in mijn basisbestand heb ik een aantal regels waarvan elke regel een apart document moet krijgen. Elk apart document wordt namelijk gebruikt om in te lezen in een ERP systeem. Ik kan het basisbestand met 20 regels niet tegelijk inlezen in het ERP systeem. Daarom vroeg ik mij af of het mogelijk is om via een macro het basisbestand zo te bewerken, zodat Excel bij elke regel een nieuw document creëert die ik wel kan inlezen.

Ik hoop dat zoiets mogelijk is. Alvast hartelijk bedankt voor de reacties!

Met vriendelijke groet,

Bas

 

[zapatr]

Zoals anderen vóór mij op dit forum al meer dan honderd keer hebben geschreven:
Bij zo'n soort vraag is het pas mogelijk om een goed antwoord te geven als je een voorbeeldbestand bijvoegt !!

 

[ClickandKnow]

Zoals ZAPATR al melde, geef een voorbeeldbestand dat is veel makkelijker om te begrijpen dan de uitleg die je nu hebt gegevens.
onderstaande zou je kunnen gebruiken, let op! dit is niet exact de code die je nodig hebt (ook is deze niet geoptimaliseerd).

path = range("GEEF EEN LOCATIE") 'locatie van de cel die het path bevat

'kijken of het path bestaat

Dim FSOobj As Object
Set FSOobj = CreateObject("Scripting.FilesystemObject")

If FSOobj.FolderExists(path) = False Then
Answer = MsgBox("De folder waar u het bestand wil opslaan bestaat niet." & vbCrLf & _
"Wilt u deze folder aanmaken?", vbYesNo, "Folder doesn't exist")
If Answer = vbYes Then
CreateDirs path
Else
End
End If
End If

sheets("Sheetwaardegegevensstaan").select 'sheet waar de te kopieren gegevens staan
range("A1").select 'cel waar de eerste regel staat die gekopieerd dient te worden

Do until activecel = ""
Naam = activecell 'de naam die je geeft aan het bestand
Sheets.Add.Name = "geefeensheetnaam" 'sheetnaam geven tussen aanhalingstekens
sheets("Sheetwaardegegevensstaan").select 'sheet waar de te kopieren gegevens staan
activecell.copy
sheets("geefeensheetnaam").select 'sheetnaam geven tussen aanhalingstekens
activesheet.paste
activesheet.copy
activeworkbook.SaveAs FileName:=(path & naam & ".xlsm"), FileFormat:=xlOpenXMLWorkbookMacroEnabled
activeworkbook.close

sheets("Sheetwaardegegevensstaan").select 'sheet waar de te kopieren gegevens staan
activecell.offset(1,0).select
Loop

 

[luibak]

Als je de onderstaande VBA code gerbuikt moet het lukken,
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sh As Worksheet, isect As Range, c As Range
Set isect = Intersect(Target, Columns("A"))

If isect Is Nothing Then Exit Sub
On Error Resume Next
For Each c In isect.Cells
If c <> "" Then
Set sh = Nothing: Set sh = Sheets(c.Value)
If sh Is Nothing Then
Sheets("Formatwerkbladen").Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = c.Value
Else
MsgBox "dat werkblad " & c.Value & " bestaat al" & vbLf & "FATAL ERROR"
End If
End If
Next
End Sub

Je zal hier bij wel 2 tabbladen al moeten hebben eentje met de naam start hier kan je de gegevens die je wilt als tabbladden in kolum A plaatsen.(hier moet je ook de code achter plaatsen)

tevens zal je ook een werkblad formaat aan moeten maken deze kan je zo instellen als je zelf wilt en dan zal hij ze copieren voor je.

marco

Ps met de zoek functie had je dit kunnen vinden heb ik namelijk ook op die manier gevonden credits naar de originele makkers.