Aus vielen Tabellen mehrere Einzeldateien erstelle

Hallo liebes Forum,
ich habe ein Problem, keine Ahnung von VBA (schlechte Mischung) und komme leider nicht weiter.
Und zwar sollen aus einer Basisdatei mit ca. 100 in gleichmäßigen Abständen enthaltenen Tabellen mehrere einzelne Excel-Dateien erstellt werden (mit jeweils einer Einzeltabelle).
Meine Fragen wären: ist dies a) möglich (VBA?) und b) wie/wo kann man da ansetzen?
Im Detail wären die Anforderungen:
1. die automatisch erstellten Dateien können im gleichen Verzeichnis wie die Basisdatei abgelegt werden
2. in der Basistabelle befinden sich etwa 50-100 Tabellen. Die Tabellen sollen immer mit Inhalten und Format kopiert werden (jeweils bis Zeile 5000).
Jede zu kopierende Tabelle umfasst 7 Spalten. Die erste Tabelle beginnt somit bei Spalte A (bis G), die zweite bei H (bis N), die dritte bei O (bis U) usw.
Im Optimalfall kann man vor dem VBA-Prozess manuell festlegen, für wieviele Tabellen der Prozess ablaufen soll (natürlich immer von links nach rechts bei der Basistabelle
ausgehend) oder welche Spalte die letzte ist, woraus eine Einzeldatei entstehen soll.
3. Der Dateiname (der zu erstellenden Datei) befindet sich jeweils im oberen linken Feld jeder Tabelle. Also für Tabelle 1 in A1, für Tabelle 2 in H1, für Tabelle 3 in O1 usw.
Userbild

Musterdatei mit drei Tabellen als Beispiel: https://www.herber.de/bbs/user/96131.xlsx
Hätte jemand eine Idee oder einen Ansatz?
Ist das mit Excel realisierbar?
Viele Grüße
Joerschi

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Sub ErstelleDateien() Dim letzteSpalte As Integer Dim letzteZeile As Long Dim wkb As Workbook Dim i As Integer Dim strfile As String letzteZeile = Sheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Row letzteSpalte = Sheets("Tabelle1").Cells(1, 256).End(xlToLeft).Column Set wkb = ThisWorkbook For i = 1 To letzteSpalte Step 7 strfile = Sheets("Tabelle1").Cells(1, i).Value & "xlsx" Sheets("Tabelle1").Range("A" & i & ":" & WandleZahlInBuchstaben(i + 6) & letzteZeile). _ Copy Workbooks.Add ActiveSheet.Paste Application.CutCopyMode = False ActiveWorkbook.SaveAs Filename:=wkb.Path & "\" & strfile, _ FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False ActiveWorkbook.Close wkb.Activate Next i End Sub Function WandleZahlInBuchstaben(ByVal iWert As Integer) As String Dim Spaltenbuchstabe As String Spaltenbuchstabe = Right(Columns(iWert).Address, _ Len(Columns(iWert).Address) - _ InStrRev(Columns(iWert).Address, "$")) WandleZahlInBuchstaben = Spaltenbuchstabe End Function

Hi Yummy,
besten Dank.
Klappt schon gut, aber es scheint noch ein Bug drin zu sein :-(
Ab der zweiten Tabelle (generiertes Einzeldokument) wird Tabelle 1 UND 2 mit kopiert. Außerdem werden oben die ersten 6 Zeilen weggeschnitten. Bei Tabelle 2 dann die obersten 13 Zeilen weg usw.
Zwei Bitten:
1. Kann man die Zieldatei auf .xls-Format umstellen?
2. Ist es möglich, dass man z. B. in Zelle F1 den Beginn der letzten Tabelle definiert (als Zahl), also welche Tabelle als Letztes in ein Einzeldokument gewandelt werden soll? Die Zahl würde es zwar dann mitkopieren aber das wäre nicht so schlimm.... So muss man bei variierender Tabellenanzahl nicht mehr in den VBA-Code rein.
Danke Dir auf jeden Fall für den bisherigen Ansatz!
Liebe Grüße, Joerschi

Option Explicit Sub ErstelleDateien() Dim letzteSpalte As Integer Dim letzteZeile As Long Dim wkb As Workbook Dim i As Integer Dim strfile As String letzteZeile = Sheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Row letzteSpalte = Sheets("Tabelle1").Cells(1, 256).End(xlToLeft).Column Set wkb = ThisWorkbook For i = 1 To letzteSpalte Step 7 strfile = Sheets("Tabelle1").Cells(1, i).Value & ".xls" Sheets("Tabelle1").Range(WandleZahlInBuchstaben(i) & "1:" & WandleZahlInBuchstaben(i + _ 6) & letzteZeile). _ Copy Workbooks.Add ActiveSheet.Paste Application.CutCopyMode = False ActiveWorkbook.SaveAs Filename:=wkb.Path & "\" & strfile, _ FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False ActiveWorkbook.Close wkb.Activate Next i End Sub Function WandleZahlInBuchstaben(ByVal iWert As Integer) As String Dim Spaltenbuchstabe As String Spaltenbuchstabe = Right(Columns(iWert).Address, _ Len(Columns(iWert).Address) - _ InStrRev(Columns(iWert).Address, "$")) WandleZahlInBuchstaben = Spaltenbuchstabe End Function

Beliebteste Forumthreads (12 Monate)

Aus vielen Tabellen mehrere Einzeldateien erstelle

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread