mehrere Tabellen aus mehreren Arbeitsblätter zusammenführen

[sekidame]

Hallo zusammen

ich habe eine Excel-Datei mit jeder Menge Arbeitsblätter. Überall ist der Aufbau der Tabelle gleich.
Diese Tabellen möchte ich in ein neues Arbeitsblatt kopieren, nicht konsolidieren.

Klar geht es, jede Tabelle markieren und mit STGR C + STGR V in das Zielblatt zu kopieren. Aber bei der Menger der Blätter ist das eine nervige Aufgabe.

Weiß jemand eine Möglichkeit das irgendwie zu automatisieren?
Die Anzahl der Spalten und die Beschriftung der Spalten ist bei allen gleich. Die Anzahl der Zeilen ist unterschiedlich.

Anbei eine Testdatei (die Original ist natürlich viel größer)

Vielen Dank für Eure Hilfe
Grüße

[snb]

Die Splittung der Daten hätte nie passieren dürfen.

[Ralf A]

Hi,

in Zukunft snb's Hinweis beachten!

Zur Behebung Deines angerichteten Schadens kannst Du VBA verwenden oder PQ. Ich hab Dir mal mit PQ eine Lösung erstellt:

PHP-Code:

let
    Quelle = Excel.Workbook(File.Contents("C:\Users\User\Downloads\Test Tabellen zusammen kopieren.xlsx"), null, true),
    #"Erweiterte Data" = Table.ExpandTableColumn(Quelle, "Data", {"Column1", "Column2", "Column3", "Column4", "Column5"}, {"Column1", "Column2", "Column3", "Column4", "Column5"}),
    #"Andere entfernte Spalten" = Table.SelectColumns(#"Erweiterte Data",{"Column1", "Column2", "Column3", "Column4", "Column5", "Name"}),
    #"Entfernte oberste Zeilen" = Table.Skip(#"Andere entfernte Spalten",1),
    #"Höher gestufte Header" = Table.PromoteHeaders(#"Entfernte oberste Zeilen", [PromoteAllScalars=true]),
    #"Gefilterte Zeilen" = Table.SelectRows(#"Höher gestufte Header", each ([Vorname] <> "Vorname")),
    #"Umbenannte Spalten" = Table.RenameColumns(#"Gefilterte Zeilen",{{"Kurs 1", "Kurs"}})
in
    #"Umbenannte Spalten" 


Wobei Du natürlich den Pfad für die Quelle und ggf. die Spaltenangben in den erweiterten Daten noch anpassen musst...

[Gast 123]

Hallo

ich habe mal eine VBA Lösung hochgeladen.  Die Tabelle "Übersicht" benannt.

mfg Gast 123

[snb]

Code:

Sub M_snb()
  Tabelle1.Cells.Delete

  For j = 1 To Sheets.Count
    If Left(Sheets(j).Name, 1) = "K" Then Tabelle1.UsedRange.Offset(Tabelle1.UsedRange.Rows.Count * Abs((Tabelle1.Cells(1) <> ""))).Resize(Sheets(j).UsedRange.Rows.Count, 5) = Sheets(j).UsedRange.Offset(Abs(Tabelle1.Cells(1) <> "")).Value
  Next
End Sub

Ohne PQ:

Code:

Sub M_snb()
   Tabelle1.Cells.Delete

    With CreateObject("ADODB.Recordset")
      .Open "SELECT * FROM [Kurs 1$] Union Select * From  [Kurs 2$] Union Select * From  [Kurs 3$] Union Select * From  [Kurs 4$]", "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0 Xml;HDR=Yes;IMEX=1"""
      Tabelle1.Cells(2, 1).CopyFromRecordset .DataSource
    End With

    Tabelle2.UsedRange.Rows(1).Copy Tabelle1.Cells(1)
End Sub

Und etwas flexibeler:

Code:

Sub M_snb_000()
   Tabelle1.Cells.Delete
   Tabelle2.UsedRange.Rows(1).Copy Tabelle1.Cells(1)

   For Each it In Sheets
     c00 = c00 & it.Name & vbLf
   Next

    With CreateObject("ADODB.Recordset")
      .Open "SELECT * FROM [" & Join(Filter(Split(c00, vbLf), "Kurs"), "$] Union Select * From [") & "$]", "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0 Xml;HDR=Yes;IMEX=1"""
      Tabelle1.Cells(2, 1).CopyFromRecordset .DataSource
    End With
End Sub

[sekidame]

vielen Dank an alle für die Antworten.

Leider liegt es nicht in meiner Macht, dass es mehrere Tabellen sind, da die Informationen aus unterschiedlichen Abteilungen kommen.

Wäre es leichter die Tabellen zusammenzuführen, wenn es nicht unterschiedliche Blätter sondern unterschiedliche Excel-Dateien wären?

Vielen Dank auf jeden Fall und Grüße

[Ralf A]

Wäre es leichter die Tabellen zusammenzuführen, wenn es nicht unterschiedliche Blätter sondern unterschiedliche Excel-Dateien wären?

Das ist weder leichter noch schwerer, nur anders, weil ja die Bedingungen andere sind. Aber da (uns) die Bedingungern nicht bekannt sind, lässt sich da auch nichts konkretes dazu sagen...