Mehrere Tabellenblätter zusammenführen

[Sevemiyen]

Hallo zusammen

könnte mir bitte jmd bei einem Problem helfen?

Hab eine Excel-Tabelle mit 122 Tabellenblättern, auf den jeweils eine einheitliche Tabelle mit Datensätzen drin ist. (im Anhang)
Ich würde gerne die 122 Sheets zusammenführen (untereinander in einer Tabelle auflisten).

Habe es schon mit Power Querry versucht und sitze seit Stunden erfolglos dran :(

Wäre euch echt dankbar, wenn ihr mir dabei helfen können.

Ps. die Daten in der Tabelle sind nur fiktiv und dienen nur zu Übungszwecken.

[UweD]

Hallo

evtl mit diesem Makro

- Füge ein Zusammenfassungsblatt ein
- Diesen Code in ein Modul

Code:

Sub zusammenfassen()
    Dim TB As Worksheet, TBNeu As Worksheet, Z1 As Integer
    Dim LR As Long, LRNeu As Long
    Set TBNeu = Sheets("Zusammenfassung")
    Z1 = 1 ' wegen Überschrift
   
    ThisWorkbook.Save 'um benutzten Bereich zu aktualisieren
    Application.ScreenUpdating = False
    For Each TB In ThisWorkbook.Sheets
        If TB.Name <> TBNeu.Name Then
            LR = TB.Cells.SpecialCells(xlCellTypeLastCell).Row   'Letzte Zeile des gesamten Blattes
            LRNeu = TBNeu.Cells.SpecialCells(xlCellTypeLastCell).Row + 1 'erste freie Zeile
           
            TB.Rows(1).Resize(LR - Z1 + 1).Copy TBNeu.Rows(LRNeu)

        End If
   
    Next
    MsgBox "Fertig"
End Sub

LG UweD

[Sevemiyen]

Vielen Dank für die Hilfe. Aber ich bekam leider eine Fehlermeldung. Habe ich etwas falsch gemacht?

   

[theTroother]

Hallo,

dein neu eingefügtes Arbeitsblatt soll auch Zusammenfassung heißen
und NICHT
"zusammenfassen" -> wie du es benannt hast

lg theTroother

[Sevemiyen]

Das war der Fehler.

Vielen Dank nochmals an alle  
Hat dann auf Anhieb direkt geklappt.

[snb]

Oder:

Code:

Sub M_snb()
  c00 = "G:\OF\zusammen.csv"
  Set cl = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")

  With CreateObject("scripting.filesystemobject")
    .createtextfile(c00).write ""
   
    For Each it In Sheets
      it.UsedRange.Copy
      cl.GetFromClipboard
      .OpenTextFile(c00, 8).write Replace(cl.gettext, vbTab, ",")
    Next
  End With
 
  Sheets.Add , Sheets(Sheets.Count), , c00
End Sub

[theTroother]

Hallo snb,

ist

Code:

1C3B4210-F441-11CE-B9EA-00AA006B1A69}

die class id vom Clipboard?

und kann man da snur als "aribtrary object" instanziieren?


lg theTroother

[derHoepp]

Moin,

es handelt sich um ein DataObject: https://learn.microsoft.com/de-de/office...ect-object

Für gewöhnlich steht dies nur als Steuerelement in Mas- Forms- Anwendungen zur Verfügung, lässt sich aber eben als Besonderheit auch in Code direkt instanzieren. Dafür hat es allerdings keine "freundliche" Class-Name.

Viele Grüße 
derHöpp

---

das eigentliche Problem ist übrigens, dass deine Daten auch verbundene Zellen sowohl im Datenbereich, als auch in überschritten enthalten. Dadurch hast du letztlich keine Datenstruktur mehr, sondern vielleicht noch druckbare Liste. Also: erst aufräumen, dann klappt's auch mit PQ

[theTroother]

Danke für die Antwort und den Link DerHöpp

[Ralf A]

Hab eine Excel-Tabelle mit 122 Tabellenblättern, auf den jeweils eine einheitliche Tabelle mit Datensätzen drin ist. (im Anhang)
Ich würde gerne die 122 Sheets zusammenführen (untereinander in einer Tabelle auflisten).

Habe es schon mit Power Querry versucht und sitze seit Stunden erfolglos dran :(

...nun ja... konnte nicht mal ansatzweise einen PQ Lösungsversuch erkennen.... 

Zunächst solltest Du für dieses Vorhaben alle Tabellen in formatierte Tabellen umwandeln. Das kannst Du mit diesem Makro:

PHP-Code:

Option Explicit

Sub Umwandeln()
Dim ws As Worksheet, x As Integer
Application.ScreenUpdating = False
x = 1
For Each ws In ThisWorkbook.Worksheets
    If InStr(1, ws.Name, "Sheet") > 0 Then Unformat ws, x
    x = x + 1
Next
Worksheets(1).Activate
ActiveWorkbook.RefreshAll
Application.ScreenUpdating = True
End Sub

Sub Unformat(ws As Worksheet, x As Integer)
Dim ur As Range
On Error Resume Next
With ws
    .Select
    ActiveSheet.ListObjects("tblData" & x).Unlist
    Err.Clear
    .Cells.Select
    With Selection
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        .Borders(xlEdgeLeft).LineStyle = xlNone
        .Borders(xlEdgeTop).LineStyle = xlNone
        .Borders(xlEdgeBottom).LineStyle = xlNone
        .Borders(xlEdgeRight).LineStyle = xlNone
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone
        With .Interior
            .Pattern = xlNone
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
    End With
  
    Set ur = .UsedRange
    ActiveSheet.ListObjects.Add(xlSrcRange, Range(ur.Address), , xlYes).Name = "tblData" & x
    Range("tblData" & x & "[#All]").Select
    ActiveSheet.ListObjects("tblData" & x).TableStyle = "TableStyleMedium2"
    
End With
End Sub 


Zumindest solltest Du Sub Umwandeln beim 1. Start aufrufen (oder wenn Du andere unformatierte Tabellen hinzufügst)

Dann musst Du im PQ Editor 2 Abfragen hinzufügen.

Die 1. ist eine Funktion Namens fkAlleTabellen. Der M-Code dafür:

PHP-Code:

let
    Quelle = (Start as number, Ende as number) as table =>
let
    fktToTabelle = let
//Liste der Tabellen erstellen    
//Dieser Code entspricht im Wesentlichen einer For-Schleife und er erstellt eine Liste von Tabellen, die jeweils in der internen Abfrage MakeTable erstellt werden.
    schreibePeriode = List.Generate
    (
      () => [akt = Start],                                         //Die Variable akt wird initialisiert
      (x) => x[akt] <= Ende,                                       //Bedingung: solange akt <= dem Ende ist
      (x) => [akt = x[akt] + 1],                              //um 1 erhöhen (andere Werte, auch negative) sind möglich
      (x) => MakeTable( Text.From(x[akt]))    //Bei jedem Durchlauf die Prozedur (Abfrage) MakeTable aufrufen
      ),
//Tabellendaten abrufen (Tabellen erstellen)
      MakeTable =   (nummer as text) =>
            let
                //Das entspricht einer normalen Abfrage zur Tabellenerstellung
                Einzeltabelle = Excel.CurrentWorkbook(){[Name="tblData" & nummer]}[Content],
                AddBlattname = Table.AddColumn( Einzeltabelle , "Blatt", each "tblData"  & nummer) //Spalte Blatt anhängen, damit man die Datenherkunft erkennen kann
            in
          AddBlattname
in 
schreibePeriode,  //das ist die Liste(!) mit allen Tabellen
//und ab hier wird die Liste (allerTabellen) in eine Tabelle umgewandelt 
    ListeToTable = Table.FromList(fktToTabelle, Splitter.SplitByNothing(), null, null, ExtraValues.Error)
in
//und die so erstellte Tabelle zurückliefern...
  ListeToTable 
in
    Quelle 


Aufgerufen wird diese Funktion in der Abfrage Namens AlleDaten. Der M-Code dafür:

PHP-Code:

let
    AnzTabs = List.Count( Excel.CurrentWorkbook()[Content]),
    Quelle = fkAlleTabellen(1, AnzTabs),
    Spaltennamen = Table.ColumnNames( Excel.CurrentWorkbook(){[Name="tblData1"]}[Content]),
    NeueListe = List.InsertRange(Spaltennamen, List.Count(Spaltennamen), {"Blatt"}),
    Expand = Table.ExpandTableColumn(Quelle, "Column1", NeueListe)
in
    Expand 


Da die Datei zum Upload vom Forum für zu groß befunden wird, hier der Link zum Download