Tabellenblätter in ein Tabellenblatt übertragen

[Thomas 2021]

Hallo Zusammen, ich habe mehrere Tabellenblätter mit Spalten A-G und 26 Zeilen.
Mit welchem Makro kann ich den Inhalt der Tabellenblätter ca. 15 Stück in einem Tabellenblatt untereinander auflisten lassen.
Danach soll der Inhalt des geschaffenen Tabellenblattes nach einer bestimmten Spalte hin aufsteigend (Zahlen) sortiert werden.

Ich habe jetzt folgendes Makro verwendet. Allerdings weiß ich nicht warum es jede Tabelle 4 Mal aufgelistet wird. 
Sub Tabellenzusammen()

'Zusammenfassen der Tabellen mit Überschriften ( Zeile 1 )
Dim Wks As Worksheet
Dim Bereich As Range
Dim strLC As String
Dim i As Integer

Set Wks = Worksheets.Add
Wks.Name = "Tabellenzusammen"

For i = 2 To Worksheets.Count
With Worksheets(i).UsedRange
  strLC = .Cells(.Rows.Count, .Columns.Count).Address
  Set Bereich = .Range("A2:" & strLC)
  Bereich.Copy Destination:= _
  Wks.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End With
Next i
End Sub

[Klaus-Dieter]

Hallo,

es gibt keine Makros für bestimmte Aufgaben, es sei denn, man programmiert sie sich.

[Thomas 2021]

ich habe ein Makro bei dem ich aber das Problem habe das jede Tabelle 4 Mal in der Zusammenfassung auftaucht.

[Steffl]

Auch Hallo,

die Add-Methode hat auch Parameter

Parameter
PARAMETER
Name Erforderlich/Optional Datentyp Beschreibung
Before Optional Variant Ein Objekt, das das Blatt angibt, vor dem das neue Blatt hinzugefügt wird.
After Optional Variant Ein Objekt, das das Blatt angibt, hinter dem das neue Blatt hinzugefügt wird.
Count Optional Variant Die Anzahl der hinzuzufügenden Zeilen. Der Standardwert ist die Anzahl der ausgewählten Blätter.
Typ Optional Variant Gibt den Blatttyp an. Kann eine der folgenden XlSheetType -Konstanten sein: xlWorksheet, xlChart, xlExcel4MacroSheetoder xlExcel4IntlMacroSheet. Wenn Sie ein Blatt basierend auf einer vorhandenen Vorlage einfügen, geben Sie den Pfad zu der Vorlage an. Der Standardwert ist xlWorksheet.

und wenn man die nicht angibt, kann folgendes passieren.

Wenn Before und After nicht angegeben werden, wird das neue Blatt vor dem aktiven Blatt eingefügt.

Das heißt, wenn bei dir nicht das erste Tabellenblatt aktiv ist, wird das Tabellenblatt zwischendrin eingefügt und vom diesen auch was in deiner Zusammenfassung eingefügt.

[WillWissen]

Hallo Thomas,

muss es unbedingt VBA sein? Wenn nicht, schau dir mal PowerQuery (Daten / Abrufen und transformieren) an.

[Gast 123]

Hallo

wenn dıe Zusammenfassung an 1. Stelle stehen soll dann aendere bitte diese Zeile:   Set Wks = Worksheets.Add(before:=Worksheets(1))
Im Code wird "Wks" als Zieltabelle verwendet. Zur Sicherheit kann man eine İF Anweisung einbauen um das Blatt "Zusammen" zu überspringen.

@Steffi   Amüsanter Fehler bei UsedRange!!   Ich kann ihn technisch nicht erklaeren. 
Ich habe fürs Forum eine Testdatei, wo ich alle Module die ich testen will rein kopiere. Mit Tabellen wie der Frager sie verwendet.  Seinen Code habe ich mit MsgBox zum testen durchgeschickt, un d einen verblüffenden Fehler festgestellt. In meiner 1. Tabelle stehen in A2 und C2 nur die Werte "1" und "Info", sonst nichts!!  In Zeile 1 erfolgte KEINE Eingabe, die ist komplett leer.  Beim Test mit der MsgBox wurde der leere Bereich von "A3:C3" kopiert, obwohl im Makro eindeutig als 1. Zelle "A2" steht. Hast du dafür eine technische Erklaerung??? Warum UsedRange hier versagt??

Baue es evtl. bitte mal mit einer kleinen Testdatei nach, ob der Effekt beim leeren Blatt auch bei dir aufttitt??  Bin gespannt auf dein Ergebnis.
@Frager:   dein Code funktioniert ansonsten einwandfrei.  Ich konnte kein 4mal kopieren feststellen!!  Es sei denn du ruft das Makro mehrfach auf???

mfg Gast 123

Code:

Sub Tabellenzusammen()

'Zusammenfassen der Tabellen mit Überschriften ( Zeile 1 )
Dim Wks As Worksheet
Dim Bereich As Range
Dim strLC As String
Dim i As Integer

Set Wks = Worksheets.Add(before:=Worksheets(1))
Wks.Name = "Tabellenzusammen"

For i = 2 To Worksheets.Count
If Worksheets(i).Name <> "Tabellenzusammen" Then
With Worksheets(i).UsedRange
  strLC = .Cells(.Rows.Count, .Columns.Count).Address
  Set Bereich = .Range("A2:" & strLC)
 
Worksheets(i).Select
  Bereich.Select
  Bereich.Copy
  MsgBox strLC
  MsgBox Bereich.Address

  Bereich.Copy Destination:= _
  Wks.Cells(Rows.Count, 1).End(xlUp).Offset(3, 0)
End With
End If
Next i
End Sub

[Steffl]

Hallo,

@Steffi   Amüsanter Fehler bei UsedRange!!   Ich kann ihn technisch nicht erklaeren. 
Ich habe fürs Forum eine Testdatei, wo ich alle Module die ich testen will rein kopiere. Mit Tabellen wie der Frager sie verwendet.  Seinen Code habe ich mit MsgBox zum testen durchgeschickt, un d einen verblüffenden Fehler festgestellt. In meiner 1. Tabelle stehen in A2 und C2 nur die Werte "1" und "Info", sonst nichts!!  In Zeile 1 erfolgte KEINE Eingabe, die ist komplett leer.  Beim Test mit der MsgBox wurde der leere Bereich von "A3:C3" kopiert, obwohl im Makro eindeutig als 1. Zelle "A2" steht. Hast du dafür eine technische Erklaerung??? Warum UsedRange hier versagt??

Baue es evtl. bitte mal mit einer kleinen Testdatei nach, ob der Effekt beim leeren Blatt auch bei dir aufttitt??  Bin gespannt auf dein Ergebnis.

ein kleiner Hinweis: Ich heiße Stefan oder meinetwegen Steffl aber nicht Steffi.
bezüglich UsedRange hast du einen kleinen Denkfehler. Aus wievielen Zeilen besteht dein UsedRange? Und worauf bezieht sich dein Range? Übrigens: Du brauchst nicht selektieren und auch deine If-Abfrage ist nicht nötig, weil Du die Zusammenfassung als erstes Blatt hast und deine For-Schleife bei 2 beginnt.

PHP-Code:

Sub Tabellenzusammenaus_CEF()

'Zusammenfassen der Tabellen mit Überschriften ( Zeile 1 )
Dim Wks As Worksheet
Dim Bereich As Range
Dim strLC As String
Dim i As Integer

Set Wks = Worksheets.Add(before:=Worksheets(1))
Wks.Name = "Tabellenzusammen"

For i = 2 To Worksheets.Count
With Worksheets(i).UsedRange
  strLC = .Cells(.Rows.Count, .Columns.Count).Address
  Set Bereich = .Cells  '.Range("A2:" & strLC)
 
  Bereich.Copy
  MsgBox strLC
  MsgBox Bereich.Address

  Bereich.Copy Destination:= _
  Wks.Cells(Wks.Rows.Count, 1).End(xlUp).Offset(3, 0)
End With
Next i
End Sub 


[Gast 123]

Hallo

@Stefan    ich bitte dich um Entschuldigung für die falsche Ansprache. 

Select verwende ich nur zum Test, wenn mir etwas unklar ist, und ich mir den definierten Bereich genauer anschauen will.  Ideal gekürzt funktioniert der Code dann so:

mfg Gast 123

Code:

Sub Tabellenzusammenaus_CEF()
'Zusammenfassen der Tabellen mit Überschriften ( Zeile 1 )
Dim Wks As Worksheet
Dim i As Integer
Set Wks = Worksheets.Add(before:=Worksheets(1))
Wks.Name = "Tabellenzusammen"

For i = 2 To Worksheets.Count
With Worksheets(i).UsedRange
  .Cells.Copy Destination:= _
  Wks.Cells(Wks.Rows.Count, 1).End(xlUp).Offset(3, 0)
End With
Next i
End Sub