Microsoft Excel

Herbers Excel/VBA-Archiv

Arbeitsblätter in einzelne Dateien aufteilen

Betrifft: Arbeitsblätter in einzelne Dateien aufteilen von: Peter Harloff
Geschrieben am: 15.09.2014 16:16:16

Hallo zusammen,

ich habe eine Datei mit vielen Arbeitsblättern die ich per Makro regelmäßig in einzelne Dateien aufteile und unter C:\Temp abspeichere. Dazu benutze ich aktuell den folgenden Code (Dateien werden anhand des Namen des Arbeitsblatts und eines ausgelesenen Datums abgespeichert):

For Each blatt In ActiveWorkbook.Worksheets
Sheets(blatt.Name).Copy
ActiveWorkbook.SaveAs Filename:="C:\Temp\" & blatt.Name & " ab " & TEDate & ".xlsx"
ActiveWorkbook.Close
Next blatt


Das funktioniert soweit auch super. Nur habe ich das Problem, dass einige dieser einzelnen Arbeitsblätter in eine Datei gehören müssten, nämlich dann, wenn die ersten drei UND die letzten drei Stellen des Arbeitsblattnamens identisch sind. Ein Beispiel für die Arbeitsblätter in meiner großen Datei:

- 211 TGE
- 225-00 TGE
- 225-01, 02 TGE

- 229 TGE
- 236-00 TGE
- 236-01, 03 TGE

- 211 ZJE
- 225-00 ZJE
- 225-01, 02 ZJE

- 229 ZJE
- 236-00 ZJE
- 236-01, 03 ZJE


Im Moment wird jedes dieser Arbeitsblätter in einer eigenen Datei abgespeichert. Das hilft schon enorm. Allerdings gehören eigentlich "225-00 TGE" und "225-01, 02 TGE" in eine Datei sowie "225-00 ZJE" und "225-01, 02 ZJE" auch. Ich habe mehrere dieser "großen" Dateien, darum kann ich die Liste auch nicht "hart" ins Makro schreiben - eine "Erkennung", ob die ersten drei Stellen (im Beispiel 225) UND die letzten drei Stellen (TGE bzw. ZJE) mehrmals auftauchen (kann auch drei Mal sein!), wäre die beste Variante.

Die neue Datei müsste dann wiederum - im Gegensatz zum aktuellen Code, der ja nur pauschal den Arbeitsblattnamen (bspw. 225-00 TGE) nimmt - unter 225 TGE abgespeichert werden, also ohne Zusatz "00" oder "01, 02", da ja nun beide Arbeitsblätter in der Datei enthalten sind. Für alle anderen Arbeitsblätter wie bspw. 211 TGE oder 229 ZJE soll das Makro weiterhin genau das tun, was es heute tut.

Gibt es hier einen VBA-Gott, der das lösen kann? Der manuelle Aufwand das immer zusammen zu führen ist wirklich riesig :-(

Für tolle Hilfe spendiere ich gern ein Bier :-)

  

Betrifft: AW: Arbeitsblätter in einzelne Dateien aufteilen von: Rudi Maintaire
Geschrieben am: 15.09.2014 16:47:44

Hallo,
teste mal:

Sub aaaa()
  Dim i As Integer, j As Integer, objWks As Object, strWks As String, arrWks
  Set objWks = CreateObject("scripting.dictionary")
  For i = 1 To Worksheets.Count - 1
    If Not objWks.exists(Sheets(i).Name) Then
      strWks = Sheets(i).Name
      objWks(Sheets(1).Name) = 0
      For j = i + 1 To Worksheets.Count
        If Not objWks.exists(Sheets(j).Name) Then
          If Left(Sheets(j).Name, 3) = Left(Sheets(i).Name, 3) _
             And Right(Sheets(j).Name, 3) = Right(Sheets(i).Name, 3) Then
            strWks = strWks & "|" & Sheets(j).Name
            objWks(Sheets(j).Name) = 0
          End If
        End If
      Next
      arrWks = Split(strWks, "|")
      Sheets(arrWks).Copy
      With ActiveWorkbook
        If UBound(arrWks) > 0 Then
          .SaveAs "c:\test\" _
            & Left(arrWks(0), 3) & " " _
            & Right(arrWks(0), 3) & " ab " _
            & Format(Date, "YYYYMMDD")
        Else
          .SaveAs "c:\test\" & arrWks(0) & " ab " _
            & Format(Date, "YYYYMMDD")
        End If
        .Close
      End With
    End If
  Next
End Sub

Gruß
Rudi


  

Betrifft: AW: Arbeitsblätter in einzelne Dateien aufteilen von: Peter Harloff
Geschrieben am: 15.09.2014 17:18:18

Hallo Rudi,

Bin sprachlos - ich hätte nicht so schnell mit einer Antwort gerechnet. Und es läuft fast rund - bin schwer begeistert :-) Einen Haken habe ich aber leider noch gefunden - das allerletzte Arbeitsblatt finde ich anschließend nicht im Zielordner als separate Datei? Könnte das am Namen ("247+232+263 ZJE")oder an einem Zähler liegen?


  

Betrifft: AW: Arbeitsblätter in einzelne Dateien aufteilen von: Luschi
Geschrieben am: 15.09.2014 17:48:52

Hallo Peter & Rudi,

das noch auftretenden Problem liegt wahrscheinlich an diesem Konstrukt:


For i = 1 To Worksheets.Count - 1
    If Not objWks.exists(Sheets(i).Name) Then

bzw.

For j = i + 1 To Worksheets.Count
    If Not objWks.exists(Sheets(j).Name) Then
Hier werden 2 unterschiedliche Excel-Objekte miteinander vermischt.
- Sheets ist die Auflistung aller möglichen Tabellenarten: Tabellenblatt, Makro4-Vorlage, Diagramm usw.
- Worksheets ist aber nur die Auflistung der Tabellenblätter
und da muß eben Sheets(2) nicht gleich Worksheets(2) sein.

Aber Rudi wird das schon richten!

Gruß von Luschi
aus klein-Paris




  

Betrifft: das wirds sein owT von: Rudi m
Geschrieben am: 15.09.2014 22:21:37




  

Betrifft: AW: das wirds sein owT von: Peter Harloff
Geschrieben am: 16.09.2014 12:26:30

Hallo Rudi,

das Problem habe ich gelöst. Dein Makro läuft super - vielen Dank.

Eine Frage hätte ich noch. Die Einzeldateien werden ja aktuell unter C:\Temp abgespeichert. Von dort aus verschiebe ich sie noch manuell in die richtigen Ordner.
Was muss ich an deinem Makro anpassen, dass die Eineldateien, die auf ".....TGE ab YYYYMMDD" enden in Pfad A und die Einzeldateien, die auf ".....ZJE ab YYYYMMDD" in Pfad B abgespeichert werden?

Dass diese Pfade automatisch angelegt werden, habe ich schon hinbekommen.

Gruß aus Berlin,

Peter


  

Betrifft: AW: das wirds sein owT von: Rudi Maintaire
Geschrieben am: 16.09.2014 12:45:33

Hallo,
ändere den Pfad hier:

            If UBound(arrWks) > 0 Then
              .SaveAs "c:\test\" _
                & Left(arrWks(0), 3) & " " _
                & Right(arrWks(0), 3) & " ab " _
                & Format(Date, "YYYYMMDD")
            Else
              .SaveAs "c:\test\" & arrWks(0) & " ab " _
                & Format(Date, "YYYYMMDD")
            End If

Gruß
Rudi


  

Betrifft: AW: das wirds sein owT von: Peter Harloff
Geschrieben am: 16.09.2014 13:01:00

Ich meine an dieser Stelle wird nur definiert, wo ALLE Einzeldateien abgespeichert werden, einmal die "normalen" Einzeldateien (Else) und einmal die, wo mehrere Arbeitsblätter in einer Datei abgespeichert wurden (If), richtig?

Ich möchte aber, dass anhand des Kriteriums TGE oder ZJE die Dateien entweder in einem Ordner "xxxxx TGE" oder "xxxxx ZJE" abgespeichert werden, die zuvor bereits erstellt wurden. Die Namen der Einzeldateien haben ja das Muster "225 TGE ab YYYYMMDD.xlsx" oder "225 ZJE ab YYYYMMDD.xlsx" Für die Entscheidung über den Zielordner spielt dann die "225" keine Rolle mehr, nur noch ob TGE oder ZJE - wobei man wohl am besten von rechts prüft, da "225" auch mal "225+xxxx" sein kann, der Teil "TGE ab YYYYMMDD.xlsx" bzw. "ZJE ab YYYYMMDD.xlsx" aber immer gleich lang ist.

Jetzt bin ich ahnungslos, was am besten ist - gleich beim Aufteilen den Speicherort zu ermitteln oder sie erst - wie aktuell - in C:\Test zwischen zu speichern und dann zu verschieben?

Viele Grüße


  

Betrifft: AW: das wirds sein owT von: Rudi Maintaire
Geschrieben am: 16.09.2014 13:07:22

Hallo,
hab ich falsch verstanden

            If UBound(arrWks) > 0 Then
              .SaveAs "c:\test\xxxxx " & Right(arrWks(0), 3) &"\" _
                & Left(arrWks(0), 3) & " " _
                & Right(arrWks(0), 3) & " ab " _
                & Format(Date, "YYYYMMDD")
            Else
              .SaveAs "c:\test\" & arrWks(0) & " ab " _
                & Format(Date, "YYYYMMDD")
            End If

und c:\test\ kannst du an deinen Ordner anpassen.

Gruß
Rudi


  

Betrifft: AW: das wirds sein owT von: Peter Harloff
Geschrieben am: 16.09.2014 14:08:35

Hallo Rudi,

tut mir leid, aber ich glaube ich drücke mich falsch aus.

Dein ursprünglicher Code sorgt dafür, dass die Arbeitsblätter 211 TGE und 211 ZJE einfach nur per Blattname + ab YYYYMMDD.xlsx in jeweils einer neuen Datei gespeichert werden, weil es 211 TGE und 211 ZJE nur ein Mal in der Ursprungsdatei gibt.

Die Arbeitsblätter 225-00 TGE und 225-01, 02 TGE dagegen werden gemeinsam als 225 TGE in einer Datei abgespeichert sowie 225-00 ZJE und 225-01, 02 ZJE als 225 ZJE, weil es eben 225...TGE und 225...ZJE in der Ursprungsdatei jeweils zwei Mal gibt.

Sprich der Code unterscheidet, ob er für den Dateinamen platt den Arbeitsblattnamen verwendet oder nur die ersten drei Stellen des Arbeitsblattnamens (225) und ob er, wenn etwas doppelt auftaucht, das in eine Datei packt. Soweit auch richtig und super.

Wenn ich aber in diesem Code den Pfad anpasse, erreiche ich nur, dass die Dateien, wo zum speichern 1:1 der Blattname verwendet wurde (211 TGE und 211 ZJE) in Pfad A landen und die Dateien, wo nur die ersten drei Ziffern für den Dateinamen verwendet wurden (225 TGE und 225 ZJE) in Pfad B. Ich möchte aber 211 TGE und 225 TGE in einem Ordner sowie 211 ZJE und 225 ZJE gemeinsam in einem anderen Ordner.

Ich hoffe ich konnte es verständlich machen!


  

Betrifft: AW: das wirds sein owT von: Rudi Maintaire
Geschrieben am: 16.09.2014 15:10:11

Hallo,
also alle TGE in einen Ordner und alle ZJE in einen Ordner!
Bedingung: Alle Blätter enden auf TGE oder ZJE und die Ordner existieren.

Sub aaaa()
  Dim i As Integer, j As Integer, objWks As Object, strWks As String, arrWks
  Dim strFolder As String, strSubFolder As String
  strFolder = "c:\test\" 'Grundordner
  Set objWks = CreateObject("scripting.dictionary")
  Application.ScreenUpdating = False
  For i = 1 To Worksheets.Count - 1
    If Not objWks.exists(Worksheets(i).Name) Then
      strWks = Worksheets(i).Name
      objWks(Worksheets(1).Name) = 0
      For j = i + 1 To Worksheets.Count
        If Not objWks.exists(Worksheets(j).Name) Then
          If Left(Worksheets(j).Name, 3) = Left(Worksheets(i).Name, 3) _
             And Right(Worksheets(j).Name, 3) = Right(Worksheets(i).Name, 3) Then
            strWks = strWks & "|" & Worksheets(j).Name
            objWks(Worksheets(j).Name) = 0
          End If
        End If
      Next
      arrWks = Split(strWks, "|")
      Worksheets(arrWks).Copy
      strSubFolder = strFolder & Right(arrWks(0), 3) & "\" 'TGE oder ZJE anhängen
      With ActiveWorkbook
        If UBound(arrWks) > 0 Then                      'mehrere Blätter
          .SaveAs strSubFolder _
            & Left(arrWks(0), 3) & " " _
            & Right(arrWks(0), 3) & " ab " _
            & Format(Date, "YYYYMMDD")
        Else                                            'nur 1 Blatt
          .SaveAs strSubFolder _
            & arrWks(0) & " ab " _
            & Format(Date, "YYYYMMDD")
        End If
        .Close
      End With
    End If
  Next
End Sub

Gruß
Rudi


  

Betrifft: AW: Arbeitsblätter in einzelne Dateien aufteilen von: Daniel
Geschrieben am: 15.09.2014 17:00:57

Hi

probiere mal das (testen kann ichs nicht)

Sub test()
Dim WB As Workbook
Dim Nme As String
Dim Blatt As Worksheet

For Each Blatt In ActiveWorkbook.Worksheets
    
    Nme = Left(Blatt.Name, 3) & " " & Right(Blatt.Name, 3) & " ab " & Format(TEDate, "YYYY-MM- _
DD")
    
    Set WB = Nothing
    On Error Resume Next
    Set WB = Worksheets(Nme & ".xlsx")
    On Error GoTo 0
    
    If WB Is Nothing Then
        Set WB = Worksheets.Add(xlWBATWorksheet)
        Blatt.Copy after:=WB.Worksheets(1)
        Application.DisplayAlerts = False
        WB.Worksheets(1).Delete
        Application.DisplayAlerts = True
        WB.SaveAs Filename:="C:\Temp\" & Nme, FileFormat:=xlOpenXMLWorkbook
    Else
        Blatt.Copy after:=WB.Worksheets(WB.Worksheets.Count)
        WB.Save
    End If

Next Blatt

For Each WB In Application.Workbooks
If WB.FullName Like "C:\Temp\*" Then WB.Close False
Next
End Sub
ich habe noch ein paar weiter Korrekturen einfügt:
- Dateinamen sollte keine Punkte enthalten. Das ist zwar erlaubt, kann aber Probleme mit der Dateierweiterung geben, daher wird das Datum im Dateinamen im Format JJJJ-MM-TT geschrieben (ist sowieso besser)
- beim Speichern sollte die Dateierweitung nicht mit angegeben werden (das macht das System automatisch), dafür muss man den Dateityp angeben.

Gruß Daniel


  

Betrifft: AW: Arbeitsblätter in einzelne Dateien aufteilen von: Peter Harloff
Geschrieben am: 15.09.2014 17:33:37

Hallo Daniel,

danke für deinen Vorschlag - leider hängt sich die Kiste am folgenden Syntax auf?
Nme = Left(Blatt.Name, 3) & " " & Right(Blatt.Name, 3) & " ab " & Format(TEDate, "YYYY-MM- _
DD")

Deinen Hinweis mit dem Datumsformat nehme ich gern an. Das mit dem Dateiformat habe ich leider nicht ganz verstanden. Meine Ursprungsdatei ist eine xlm. Wenn ich kein Format festlege, werden die Einzeldateien dann nicht auch als xlm gespeichert? Die Dateien sind für "externe User" und sollten darum keine Makros mehr enthalten, darum das xlsx.


  

Betrifft: AW: Arbeitsblätter in einzelne Dateien aufteilen von: Daniel
Geschrieben am: 15.09.2014 23:03:47

Hi
in der Zeile ist kein Syntaxfehler drin.
Das Problem ist, dass die Software dieses Forums etwas seltsam ist.
Beispielsweise fügt sie manchmal, wenn die Zeile zu lang ist, einen VBA-Zeilenumbruch ein, aber leider an der falschen Stelle und ohne berücksichtigung, obs mitten im String ist oder nicht.
Diese Zeilenumbrüche muss man dann von Hand entfernen, wenn man den Code einfach per Copy-Paste guttenbergt, anstatt ihn selbst zu schreiben.
Die Zeile muss am Ende so aussehn:

...& Format(TEDate, "YYYY-MM-DD")
das FileFormat legst du bei SaveAs über den ensprechenden Parameter fest.
die dazugehörige Dateierweiterung wird dann beim Speichern automatisch angehängt.
Seit Excel 2007 muss man das so machen, weil es nicht mehr nur ein Excel-Standard-Format gibt (xls) welches automatisch verwendet werden kann, sonden vier verschiedene (xls, xlsx, xlsm, xlsb)

Gruß Daniel


 

Beiträge aus den Excel-Beispielen zum Thema "Arbeitsblätter in einzelne Dateien aufteilen"