Einzelne Dateien aus Excel Inhalt erstellen

Forumthread: Einzelne Dateien aus Excel Inhalt erstellen

31.01.2024 10:21:00

notti

Hallo zusammen,

folgende Situation:

Ich habe eine Excel Datei mit Daten. In Spalte A stehen verschiedene Kostenstellen untereinander. Diese wiederholen sich unterschiedlich oft und sind absteigend sortiert.
Insgesamt befinden sich dazugehörige Werte in den Spalten A bis AD.

Ich würde gerne für jede Kostenstelle eine separate Datei erstellen, die dann wiederum in einem vorgegeben Ordner abgespeichert wird. (im Idealfall wird jede Datei per Outlook an eine vorgegebene Emailadresse verschickt.)

Ich hoffe man kann einigermaßen nachvollziehen was ich vor habe.

Ich wäre sehr dankbar, wenn mir jemand bei der Lösung helfen könnte.

Vielen Dank und schöne Grüße :)

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Einzelne Dateien aus Excel Inhalt erstellen

31.01.2024 16:13:27

Oberschlumpf

Hi,

...bei der Lösung helfen... ???

Im Moment sieht das, was du geschrieben hast, eher nach einer Auftragsprogrammierung aus.
Du (be)schreibst nur, was du haben möchtest.
Kannst du uns bitte per Upload eine Bsp-Datei mit genügend Datenzeilen zeigen, die ausreichend bis Spalte AD mit genügend unterschiedlichen Bsp-Daten gefüllt ist.
Da ja niemand von uns weiß, wie deine Datei aussieht - kann auch niemand von uns deine Datei nachbauen.

Ciao
Thorsten

AW: Einzelne Dateien aus Excel Inhalt erstellen

31.01.2024 16:23:07

notti

Sorry für die unvollständige Anfrage.... war meine Erste hier im Forum.

Ich habe die Datei beigefügt, jedoch ein bisschen zusammengestampft. Tut allerdings auch nichts zur Sache ob die Daten bis Spalte AD gehen oder bis T.

Ich würde gerne je Kostenstelle eine Datei erstellen, die die jeweiligen Daten enthält.

https://www.herber.de/bbs/user/166648.xlsx

AW: Einzelne Dateien aus Excel Inhalt erstellen

31.01.2024 17:10:41

UweD

Hallo

hier mal einen noch nicht zu Ende getestete Version

Sub Gruppe_neues_Blatt()

    On Error GoTo Fehler

    Dim Sp As Integer, LR As Long, I As Long, TB1, TB2, Pfad As String

    

    Pfad = "D:\Excel\Temp\"

    Sp = 1 'Spalte A

    

    Application.ScreenUpdating = False

    ActiveSheet.Copy after:=Sheets(Sheets.Count)

    Set TB1 = ActiveSheet

    LR = TB1.Cells(TB1.Rows.Count, Sp).End(xlUp).Row 'letzte Zeile der Spalte



    

    For I = LR To 2 Step -1

        If TB1.Cells(I, Sp).Value > "" And TB1.Cells(I - 1, Sp).Value > _

            TB1.Cells(I, Sp).Value Then

            

            Sheets.Add after:=Sheets(Sheets.Count)

            Set TB2 = ActiveSheet

            TB1.Rows("1:1").Copy TB2.Cells(1, 1)

            TB1.Rows(I & ":" & LR).Copy TB2.Cells(2, 1)

            TB1.Rows(I & ":" & LR).Delete xlUp

            TB2.Name = Trim(TB2.Cells(2, Sp).Text)

            LR = I

            TB2.Move

            With ActiveWorkbook

                Application.DisplayAlerts = False

                .SaveAs Filename:=Pfad & ActiveSheet.Name, FileFormat:=xlOpenXMLWorkbook

                Application.DisplayAlerts = True

               .Close

            End With

        End If

    Next

    Application.DisplayAlerts = False

    ActiveSheet.Delete

    Application.DisplayAlerts = True



    Err.Clear

Fehler:

    If Err.Number > 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err.Clear

    Application.DisplayAlerts = True

End Sub

LG UweD

AW: Einzelne Dateien aus Excel Inhalt erstellen

01.02.2024 09:21:16

UweD

Hi

habe überflüssiges noch rausgeworfen und zum Nachverfolgen kommentiert

Sub Gruppe_neues_Blatt()

    On Error GoTo Fehler

    Dim Sp As Integer, LR As Long, I As Long, TB1, TB2, Pfad As String, Anz As Integer

    

    Pfad = "D:\Excel\Temp\"

    Sp = 1 'Spalte A

    

    Application.ScreenUpdating = False

    

    Set TB1 = Sheets("bearbeitet")

    

    LR = TB1.Cells(TB1.Rows.Count, Sp).End(xlUp).Row 'letzte Zeile der Spalte



    

    For I = LR To 2 Step -1

        If TB1.Cells(I, Sp).Value > "" And TB1.Cells(I - 1, Sp).Value > _

            TB1.Cells(I, Sp).Value Then

            

            'eigenständiges Blatt erstellen

            Sheets.Add after:=Sheets(Sheets.Count)

            Set TB2 = ActiveSheet

            

            'Überschrift und Rest kopieren

            TB1.Rows("1:1").Copy TB2.Cells(1, 1)

            TB1.Rows(I & ":" & LR).Copy TB2.Cells(2, 1)

            

            

            'Blatt umbenennen

            TB2.Name = Trim(TB2.Cells(2, Sp).Text)

            

            LR = I - 1 'Ende für nächsten Lauf

            

            TB2.Move 'Blatt in Eigene Datei verschieben

            

            'Neue Datei speichern und schließen

            With ActiveWorkbook

                Anz = Anz + 1

                Application.DisplayAlerts = False 'Bei überschreiben Nicht extra fragen

                .SaveAs Filename:=Pfad & ActiveSheet.Name, FileFormat:=xlOpenXMLWorkbook

                Application.DisplayAlerts = True

               .Close

            End With

        End If

    Next

    

    MsgBox Anz & " Dateien erstellt!"



    Err.Clear

Fehler:

    If Err.Number > 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err.Clear

    Application.DisplayAlerts = True

End Sub

LG UweD

AW: Einzelne Dateien aus Excel Inhalt erstellen

01.02.2024 11:39:20

notti

Hallo Uwe,

vielen Dank für deine Mühe. Das sind schon super aus.

Was mir jedoch aufgefallen ist, es wird nur eine Datei erstellt mit den Werten der ersten Kostenstelle 1234. Und diese Datei heißt nicht "1234.xlsx" sondern Testbearbeitet.xlsx
Ist es möglich das noch anzupassen und das im Besten Fall 3 Dateien mit der jeweiligen Kostenstelle als Bezeichnung erstellt werden?

VLG
notti

AW: Einzelne Dateien aus Excel Inhalt erstellen

01.02.2024 12:06:56

UweD

Hallo nochmal

Kann es sein, dass du bei Anpassung beim Pfad das abschließende \ vergessen hast

Pfad = "D:\Excel\Temp\"

LG UweD

AW: Einzelne Dateien aus Excel Inhalt erstellen

01.02.2024 14:31:41

notti

Du hast Recht. Wenn ich den \ dahinter setze, erstellt er mir eine Excel Datei die bearbeitet.xlsx heißt. Und dort sind auch nur die Daten der ersten Kostenstelle hinterlegt.

AW: Einzelne Dateien aus Excel Inhalt erstellen

01.02.2024 15:49:31

UweD

Hallo

bei mir funktioniert es problemlos.
Evtl. werden bei dir eigene Excelinstanzen verwendet.

Was wird denn in der Messagebox als Zahl angegeben?

Ich hab die Verwendung der Dateien und Blätter mal genauer angegeben.

Versuch mal:

Option Explicit

Sub Gruppe_neues_Blatt()

    On Error GoTo Fehler

    Dim Sp As Integer, LR As Long, I As Long, TB1, TB2

    Dim Pfad As String, Wb As Workbook, Anz As Integer, N As Integer

    

    Pfad = "D:\Excel\Temp\"

    Sp = 1 'Spalte A

    

    Application.ScreenUpdating = False

    

    Set TB1 = Sheets("bearbeitet")

    

    LR = TB1.Cells(TB1.Rows.Count, Sp).End(xlUp).Row 'letzte Zeile der Spalte



    

    For I = LR To 2 Step -1

        If TB1.Cells(I, Sp).Value > "" And TB1.Cells(I - 1, Sp).Value > _

            TB1.Cells(I, Sp).Value Then

            

            'eigenständiges Blatt erstellen

            Sheets.Add After:=Sheets(Sheets.Count)

            Set TB2 = ActiveSheet

            

            'Überschrift und Rest kopieren

            TB1.Rows("1:1").Copy TB2.Cells(1, 1)

            TB1.Rows(I & ":" & LR).Copy TB2.Cells(2, 1)

            

            

            'Blatt umbenennen

            TB2.Name = Trim(TB2.Cells(2, Sp).Text)

            

            LR = I - 1 'Ende für nächsten Lauf

            

            'Neue Datei anlegen

            Set Wb = Workbooks.Add

            

            TB2.Move Before:=Wb.Sheets(1) 'Blatt in Datei verschieben

            

            ' ggf restlichen Blätter löschen

            Application.DisplayAlerts = False

            For N = Wb.Sheets.Count To 2 Step -1

                Wb.Sheets(N).Delete

            Next

            

            'Neue Datei speichern und schließen

            Anz = Anz + 1 'zählen

            Wb.SaveAs Filename:=Pfad & Wb.Sheets(1).Name, FileFormat:=xlOpenXMLWorkbook

            Application.DisplayAlerts = True

            Wb.Close

            

        End If

    Next

    

    MsgBox Anz & " Dateien erstellt!"



    Err.Clear

Fehler:

    If Err.Number > 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err.Clear

    Application.DisplayAlerts = True

End Sub

LG UweD

AW: Einzelne Dateien aus Excel Inhalt erstellen

01.02.2024 16:45:47

notti

Jetzt funktioniert es.... 3 Dateien mit den Kostenstellen als Dateinamen und den korrekten Inhalten. Die Messagebox zeigt auch, dass 3 Dateien erstellt wurden.

Super, das hilft mir sehr weiter. Vielen Dank für die große Hilfe!!!

Beliebteste Forumthreads (12 Monate)

Einzelne Dateien aus Excel Inhalt erstellen

Forumthread: Einzelne Dateien aus Excel Inhalt erstellen

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread