Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1216to1220
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Blätter speichern in Ordnern

Blätter speichern in Ordnern
Michael
Hallo EXcellenzen,
einiges hab ich mir schon zusammengesucht aber nun muss ich passen oder ich denk falsch.
Excel 2007, VBA na ja, kann es anpassen aber nicht alles selber schreiben.
In einer Mappe im Arbeitsblatt "Namen" stehen
in Zelle A2 bis Ax Abkürzungen wie "AmM"
in Zelle B2 bis Bx Namen wie "Michael Ambrosch" wird für Filter gebraucht
in Zelle C2 bis Cx Ordnernamen wie "Eingang"
Nun erzeuge ich mit Makro Arbeitsblätter die den Namen aus Zelle A2 bis Ax des Arbeitsblattes "Namen" beziehen, Z.B. AmM.
Nun möchte ich die Arbeitsblätter einzeln abspeichern in den Ordnern deren Name in den Zellen C2 bis Cx des Blattes "Namen" stehen.
Also Arbeitsblatt "AmM" speichern als Datei "AmM.xlsx" im Ordner "Eingang".
Der Ordner und die Unterordner z.B. "Eingang" werden mit Makro erzeugt.
Das einzeln abspeichern geht schon mit Makro aber nur im Stammordner.
Aber den weiteren Schritt oder die Kombination der Vorgänge krieg ich nicht hin.
Danke auch für Teillösung und Ansätze
LG
Michael

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Blätter speichern in Ordnern
31.05.2011 14:33:16
Rudi
Hallo,
zeig doch mal deinen vorhandenen Code.
Gruß
Rudi
AW: Blätter speichern in Ordnern
31.05.2011 14:53:22
Michael
Hallo miteinander,
hier folgt der Code zu den Makros
Sub Blätter_erstellen()
Sheets("Namen").Select
Dim Zelle As Range
With Sheets("Namen")
For Each Zelle In Range(.Cells(2, 1), .Cells(1, 1).End(xlDown))
ThisWorkbook.Sheets.Add after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
ActiveSheet.Name = Zelle.Value
Sheets("Musterblatt").Cells.Copy Destination:=ActiveSheet.Cells
Range("A2").Select
ActiveWindow.FreezePanes = True
Next
Sheets("Namen").Select
End With
End Sub
---------------------------------------------------------
Private Sub Blätter_exportieren()
Dim WsTabelle As Worksheet
For Each WsTabelle In Sheets
WsTabelle.Copy
ActiveWorkbook.SaveAs Filename:="...Pfadname..." & "\" & ActiveSheet.Name & "_06-2011. _
xlsx"
ActiveWorkbook.Close True
Next WsTabelle
End Sub

---------------------------------------------------------
Sub OrdnerErstellen()
Dim myPath As String
Const stdPath = "...Pfadname...\" ' Hier muss der Standardpfad stehen (mit \ am Ende!)
myPath = stdPath & MonthName(Month(Date)) & "_" & Year(Date)
uordner1 = "Eingang"
uordner2 = "Ausgang"
uordner3 = "Archiv"
If Dir(myPath, vbDirectory) = "" Then
MkDir myPath
MsgBox "Der Ordner " & myPath & " wurde erzeugt."
Else
MsgBox "Der Ordner " & myPath & " ist vorhanden."
End If
' Unterordner KVs erzeugen
MkDir myPath & "\" & uordner1
'Unterordner MINI erzeugen
MkDir myPath & "\" & uordner2
'Unterordner MUSIK erzeugen
MkDir myPath & "\" & uordner3
End Sub
---------------------------------------------------------
Ich weiss der Code ist nicht optimal aber er tuts - noch
Danke
LG
Michael
Anzeige
AW: Blätter speichern in Ordnern
31.05.2011 15:18:13
Rudi
Hallo,
du solltest die Blätter direkt speichern, nicht erst hinten einfügen.
Sub Blätter_erstellen()
Dim Zelle As Range
With Sheets("Namen")
For Each Zelle In .Range(.Cells(2, 1), .Cells(1, 1).End(xlDown))
Sheets("Musterblatt").Copy
With ActiveSheet
.Name = Zelle
.Range("A2").Select
ActiveWindow.FreezePanes = True
prcSave .Parent, Zelle.Offset(, 1), Zelle.Value
End With
Next
End With
End Sub

Sub prcSave(wkb As Workbook, strFolder As String, strFileName As String)
Dim myPath As String
Const stdPath = "c:\test\" ' Hier muss der Standardpfad stehen (mit \ am Ende!)
myPath = stdPath & Format(Date, "_MMMM_YYYY")
If Dir(myPath, vbDirectory) = "" Then
MkDir myPath
End If
If Dir(myPath & "\" & strFolder, vbDirectory) = "" Then
MkDir myPath & "\" & strFolder
End If
wkb.SaveAs myPath & "\" & strFolder & "\" & strFileName & "_06-2011.xlsx"
End Sub

Gruß
Rudi
Anzeige
AW: Blätter speichern in Ordnern
31.05.2011 15:45:21
Michael
Hallo Rudi,
danke, das hab ich mir auch schon gedacht, bloss zum Zeitpunkt der Erzeugung und Speicherung haben die Blätter ja noch keinen Inhalt ausser der Kopfzeile von Blatt "Musterblatt".
Der neue Ansatz wären dann, zuerst filtern und nur die gefilterten Zeilen als benannte Mappe in den relevanten Ordner zu speichern.
Ich teste das einmal und melde mich dann wieder, wird ein bisserl dauern bin nicht so ein flinker VBAler.
LG
Michael
neuer Ansatz
31.05.2011 16:12:29
Rudi
Hallo,
so?
Option Explicit
Const stdPath = "c:\test\" ' Hier muss der Standardpfad stehen (mit \ am Ende!)
Sub Blätter_erstellen()
Dim Zelle As Range
With Sheets("Namen")
For Each Zelle In .Range(.Cells(2, 1), .Cells(1, 1).End(xlDown))
Sheets("Musterblatt").Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
ActiveSheet.Name = Zelle.Value
Range("A2").Select
ActiveWindow.FreezePanes = True
Next
End With
End Sub
Private Sub Blätter_exportieren()
Dim Zelle As Range, strSubFolder As String
With Sheets("Namen")
For Each Zelle In .Range(.Cells(2, 1), .Cells(1, 1).End(xlDown))
strSubFolder = Zelle.Offset(, 2)
OrdnerErstellen strSubFolder
Worksheets("Zelle").Copy
ActiveWorkbook.SaveAs Filename:=stdPath & "\" & strSubFolder & Zelle & "_06-2011.xlsx "
ActiveWorkbook.Close
Next Zelle
End With
End Sub
Sub OrdnerErstellen(strSubFolder As String)
Dim myPath As String, mySubFolder As String
myPath = stdPath & Format(Date, "_MMMM_YYYY")
mySubFolder = myPath & "\" & strSubFolder
If Dir(myPath, vbDirectory) = "" Then
MkDir myPath
End If
If Dir(mySubFolder, vbDirectory) = "" Then
MkDir mySubFolder
End If
End Sub
Gruß
Rudi
Anzeige
AW: neuer Ansatz
31.05.2011 16:35:28
Michael
Hallo Rudi,
danke, das ist ja nahezu Lichtgeschwindigkeit, da brauch ich etwas Zeit das durchzuspielen. Melde mich dann wieder.
LG
Michael
AW: neuer Ansatz
02.06.2011 08:02:45
Hajo_Zi
Hallo michael,
warum offen, wenn Du Dich melden willst?

80 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige