Mehrere Tabellenblätter in einen Tabellenblatt
#1
Hallo Forum,

ich suche eine Möglichkeit mehrere Tabellenblätter (40 Stück) untereinander in einem neuen Tabellenblatt darzustellen.
Eine Möglichkeit wäre Copy-Paste, aber gibt es auch eine Möglichkeit das zu automatisieren?
Die Anzahl der Spalten aller Tabellenblätte sind gleich, nur die Zeilen Einträge der einzelnen Tabellen sind unterschiedlich.

Besten Dank im Voraus
omron2003
Antworten Top
#2
https://www.heise.de/tipps-tricks/Excel-...34629.html#
Schöne Grüße
Berni
Antworten Top
#3
Hi,

in Office 2013 geht das mit Power Query. Daten --> Daten abrufen 
Danach dann, je nachdem, ob alle Blätter in gleicher Datei oder in 40 Dateien im gleichen Ordner oder auch nicht liegen, Auswahl entsprechend treffen und Tabellen kombinieren/anfügen lassen.
Der sicherste Ansatz für einen Irrtum ist der Glaube, alles im Griff zu haben.
Nur, weil ich den Recorder bedienen kann, macht mich das noch lange nicht zum Musiker.

Ciao, Ralf

Antworten Top
#4
Hallo

wenn eine einfachde VBA Lösung gewünscht ist sollte es mit diesem Makro klappen. 
Wenn die Übersicht Tabelle anders als "Übersicht" lautet muss der Tabellenname im Makro geändert werden.
Unerwünschte Tabellen, die Nicht kopiert werden sollen, kann man im Makro mit IF Then überspringen.

mfg Gast 123

Code:
Sub Tabellen_auflisten()
Dim j, lz1 As Long, lzX As Long
Dim Übs As Worksheet, Sht As String
Set Übs = Worksheets("Übersicht")
Worksheets("Übersicht").Cells.Clear
   'Schleife für alle Tabellen durchsuchen
   For j = 2 To Worksheets.Count
      Sht = Worksheets(j).Name
      'Übersicht und unerwünschte Tabellen überspringen
      If Sht = "Übersicht" Then GoTo Übs
      If Sht = "diese Tabelle Nicht auflisten" Then GoTo Übs
      'LastZell für Übersicht und Tabelle X ermitteln
      lz1 = Übs.Cells(Rows.Count, 1).End(xlUp).Row + 2  'oder 1
      lzX = Worksheets(j).Cells(Rows.Count, 1).End(xlUp).Row
      'Tabellen Name als Überschrift setzen
      If lz1 = 2 Then lz1 = 1  'Korrektur
      Übs.Cells(lz1, 1).Font.Bold = True
      Übs.Cells(lz1, 1) = Sht: lz1 = lz1 + 1
      'Daten in  Übersicht kopieren
      Worksheets(j).Range("A1:Z" & lzX).Copy
      Übs.Cells(lz1, 1).PasteSpecial xlPasteValues
Übs:  'unerwünschte Tabellen überspringen
   Next j
End Sub
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste