Excel Tabellenblätter untereinander kopieren mit Macro

Sub TabellenKopierenUntereinander()
Dim i As Integer
Dim LRow As Long

With Application
.ScreenUpdating = False 'Bildschirm aus
End With
'Neues Blatt an die erste Position einfügen
Sheets.Add Before:=Sheets(1)
'Schleife von 2 bis Anzahl der Tabellenblätter
For i = 2 To Sheets.Count
'Referenziere auf das i-Blatt
With Sheets(i)
'Zeilenummer der letzten benutzen Zelle in Spalte A
LRow = .Cells(Rows.Count, 1).End(xlUp).Row
'Kopiere alles von A13 bis AR[letzte Zeile]
.Range("A13:AR" & LRow).Copy
'Füge die Werte in erstes Blatt direkt unter die letzte Zelle in A ein
Sheets(1).Cells(Rows.Count, "A").End(xlUp)(1).PasteSpecial xlPasteValues
End With
Next
With Application
.ScreenUpdating = True 'Bildschirm aus
.CutCopyMode = False 'Kopieren aus
End With
End Sub

Hallo Martin,

nimm dann PasteSpecial:

Sub TabellenKopierenUntereinander()

Dim i As Integer

Dim LRow As Long

Application.ScreenUpdating = False

'neue Tabelle an die erste Position einfügen

Sheets.Add Before:=Sheets(1)

For i = 2 To Sheets.Count

'Ermitteln den benutzen Bereich der einzelnen Tabellenblätter

With Sheets(i)

LRow = .Cells(Rows.Count, 1).End(xlUp).Row

.Range("A12:AR" & LRow).Copy

Sheets(1).Cells(Rows.Count, "A").End(xlUp)(2).PasteSpecial xlPasteValues

End With

Next

Application.ScreenUpdating = True

End Sub

Mit freundlichen Grüßen

Claus

Hallo Claus,

vielen Dank für die schnelle Rückmeldung. Funktioniert ausgezeichnet!

Beste Grüsse,

Martin

Hi Claus,

vielen Dank. Du bist ein Genie.

Es funktioniert wunderbar.

Herzlichsten Dank!

Grüße, Nina

Hallo Nina,

sind diese Tabellen gleich aufgebaut? Bis zu welcher Spalte geht der Bereich? Haben die Tabellen Überschriften?

Claus