Registriert seit: 20.11.2017
Version(en): Excel2013
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
Registriert seit: 02.05.2018
Version(en): Excel 365 & 2016
Registriert seit: 25.11.2021
Version(en): 2019, 365
04.08.2023, 07:14
(Dieser Beitrag wurde zuletzt bearbeitet: 04.08.2023, 07:16 von Ralf A.)
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
Registriert seit: 12.03.2016
Version(en): Excel 2003
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
