Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 19:29:30
24.04.2024 18:49:56
Anzeige
Archiv - Navigation
1700to1704
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Mehrere Tabellenreiter untereinander kopieren

Mehrere Tabellenreiter untereinander kopieren
01.07.2019 18:32:40
Mara
Liebe VBA-Experten,
ich hoffe auf Eure Hilfe bei folgendem Problem:
Ich habe mehrere unterschiedliche Daten aus anderen Excel Tabellen konsolidiert in einer Excel Tabelle.
Diese sollen nun in einem Reiter untereinander gesammelt werden, um daraus eine Pivot Tabelle zu erstellen, d.h. ich benötige keine Formatierungen der Daten o.Ä.
Ich habe diesbezüglich bereits eine Variante gefunden, die funktioniert (s. https://www.herber.de/bbs/user/130679.xlsm).
Code:
Sub Pivot_Erstellung()
'Zusammenfügen der Daten untereinander, ohne Formeln
Application.ScreenUpdating = False 'Bildschirmflackern etc. ausschalten
Application.DisplayAlerts = False
Debug.Print ActiveSheet.Name 'Hinzufügen eines neuen Tabellenblatts mit dem Namen "Pivot", auf dem alle Daten untereinander gesammelt werden, um in einer Pivot Tabelle vereint werden zu können (nächster Schritt)
Sheets.Add
ActiveSheet.Name = "Pivot"
Sheets("A").Range("D7:J194").Copy
Sheets("Pivot").Range("A1").PasteSpecial xlPasteValues
Sheets("B").Range("D8:J194").Copy
Sheets("Pivot").Range("A189").PasteSpecial xlPasteValues
Sheets("C").Range("D8:J194").Copy
Sheets("Pivot").Range("A376").PasteSpecial xlPasteValues 'Achtung: Damit sich die Tabellen nicht beim Einfügen überschneiden, wird die letzte Zeile der eingefügten Daten +1 ergänzt
Sheets("D").Range("D8:J194").Copy
Sheets("Pivot").Range("A563").PasteSpecial xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Die Krux: Der Code ist auf die importierten Daten und damit auf die jeweiligen Reiter gemünzt, das heißt, wenn Kollegen damit arbeiten sollen, und die Namen der Reiter ändern, oder nicht alle aufgeführten Daten importieren, geht das Makro nicht auf.
Habt ihr eine Lösung, wie ich den Code so allgemein halten kann, dass die Logik weiterhin aufgeht?
Ich hoffe ich konnte mich einigermaßen verständlich ausdrücken. Bei Lösungsansätzen gerne mit Erläuterung, da ich gerne dazu lernen würde. :)

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

Betreff
Datum
Anwender
Anzeige
AW: Mehrere Tabellenreiter untereinander kopieren
01.07.2019 20:56:40
Regina
Moin,
wenn alle Blätter bis auf das neue Blatt "Pivot" kopiert werden sollen müsste dieser Code passen:
Sub Pivot_Erstellung()
'Zusammenfügen der Daten untereinander, ohne Formeln
Dim wks As Worksheet
Dim lng_zeile As Long
Dim bol_erster As Boolean
Application.ScreenUpdating = False 'Bildschirmflackern etc. ausschalten
Application.DisplayAlerts = False
Debug.Print ActiveSheet.Name 'Hinzufügen eines neuen Tabellenblatts mit dem Namen "Pivot", auf  _
dem alle Daten untereinander gesammelt werden, um in einer Pivot Tabelle vereint werden zu können (nächster Schritt)
Sheets.Add
ActiveSheet.Name = "Pivot"
lng_zeile = 1
bol_erster = True
For Each wks In ActiveWorkbook.Worksheets
If wks.Name  "PivoT" Then
If bol_erster = True Then
wks.Range("D7:J194").Copy
bol_erster = False
Else
wks.Range("D8:J194").Copy
Sheets("Pivot").Range("A" & lng_zeile).PasteSpecial xlPasteValues
End If
lng_zeile = Sheets("Pivot").Cells(1048576, 1).End(xlUp).Row + 1
End If
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Gruß
Regina
Anzeige
AW: Mehrere Tabellenreiter untereinander kopieren
02.07.2019 08:45:18
Daniel
Hi Regina,
sieht so aus, als wenn bei deinem Code das erste Blatt nur kopiert, aber nicht ins Pivot Blatt eingefügt wird. Die Paste Anweisung müsste hinter das "End If":
If wks.Name  "PivoT" Then
If bol_erster = True Then
wks.Range("D7:J194").Copy
bol_erster = False
Else
wks.Range("D8:J194").Copy
End If
Sheets("Pivot").Range("A" & lng_zeile).PasteSpecial xlPasteValues
lng_zeile = Sheets("Pivot").Cells(1048576, 1).End(xlUp).Row + 1
End If
Gruß
Daniel
AW: Mehrere Tabellenreiter untereinander kopieren
02.07.2019 09:02:04
Regina
Hi Daniel,
da hast Du natürlich vollkommen Recht. Habe das If.. später eingefügt, als mir die Zeile 7 wegen der Überschriften beim ersten Copy eingefallen sind, und dann das end if falsch gesetzt
Gruß
Regina
Anzeige
AW: Mehrere Tabellenreiter untereinander kopieren
02.07.2019 09:36:13
Mara
Hallo ihr beiden,
danke für eure tolle Hilfe, ich habe die Änderung nach Daniels Vorschlag umgesetzt und nun klappt alles fehlerfrei.
Vielen vielen Dank dafür!

304 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige