Live-Forum - Die aktuellen Beiträge
Datum
Titel
17.05.2024 20:08:47
Datum/Zeit in einer Zelle fixieren über Makros
17.05.2024 18:14:48
Aaaah! Tabelle erstellen mit Index
17.05.2024 17:37:33
letztes Zeichen in Zelle entfernen
17.05.2024 17:07:32
Problem bei Diagrammerstellung
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1960to1964
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1960to1964
1960to1964
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Einzelne Dateien aus Excel Inhalt erstellen

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 :)

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

Betreff
Datum
Anwender
Anzeige
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
Anzeige
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
Anzeige
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
Anzeige
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
Anzeige
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
Anzeige
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!!!

Links zu Excel-Dialogen

Frame MessageBox

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige