Erstellen mehrerer Abeitsmappen
15.10.2004 09:19:12
Daniel
ich habe folgende Problemstellung:
User gibt im userform der arbeitsmappe "inventurliste" ein jahr ein --> bei klick auf erstellen soll automatisch:
1. ein ordner jahr erstellt werden
2. im ordner jahr je ein ordner niederlassung
3. im ordner "niederlassung" zwölf Arbeitsmappen "monat", die den ersten worksheet meiner arbeitsmappe inventurliste enthalten.
4. In jeder Arbeitsmappe "monat" zwei Zellen ändern
Die Punkte 1. und 2. habe ich schon realisiert. 3. und 4. noch nicht
Wie würdet ihr das realisieren?
P.S. ja ich habe mit goto gearbeitet - bessere Lösungen are welcome :-)
Gruß
Daniel Halbe
Mein Code:
#####
Option Explicit
Private Sub CommandButton1_Click()
Dim jahr%
Dim niederlassung$
Dim monat$
Dim ordnererstellen As Object
Dim ordnerpfad$
Dim ordnername$
Dim row%
Dim vorlage$
'jahr aus textbox auslesen
jahr = UserForm1.TextBox1.Value
'ordnername- und pfad definieren
ordnername = "inventurlisten\"
ordnerpfad = ordnername & jahr
'wenn ordner und pfad nicht existieren beides erstellen
Set ordnererstellen = CreateObject("scripting.filesystemobject")
If Not ordnererstellen.folderexists(ordnername) Then
ordnererstellen.createfolder (ordnername)
Else
If Not ordnererstellen.folderexists(ordnerpfad) Then
ordnererstellen.createfolder (ordnerpfad)
Else: MsgBox ("Ordner " & ordnerpfad & " existiert bereits!")
GoTo ende
End If
End If
'für jede niederlassung im ordner des gewählten jahres einen ordner erstellen
For Each niederlassung In Range("A2:A100")
If niederlassung.Value <> "" Then
niederlassungsname = niederlassung.Value
pfadniederlassung = ordnername & jahr & "\" & niederlassungsname
If Not ordnererstellen.folderexists(pfadniederlassung) Then
ordnererstellen.createfolder (pfadniederlassung)
Else: MsgBox ("Der Ordner " & pfadniederlassung & " existiert bereits für das gewählte Jahr!")
GoTo ende
End If
'im ordner der erstellten niederlassung für jeden monat eine .xls datei anlegen
For Each monat In Range("B2:B13")
'hier weiß ich nicht weiter
Next monat
Else: GoTo weiter
End If
Next niederlassung
weiter:
ende:
End Sub