Meherere Tabellenblätter in ein Blätt zusammenführ

Hallo Zusammen,
ich habe eine Datei mit mehreren Tabellenblättern. Jetzt möchte ich aus drei bestimmten Tabellenblättern den Inhalt in ein vorgegebenes Tabellenblatt untereinander zusammenführen, also nicht aus allen vorhandenen Blättern. Das Zielblatt heißt Zusammenstellung. Die Quellblätter heißen Lieferanten, Finanzamt und Beiträge. Da der Inhalt der Quellblättern unterschiedlich lang ist (Zeilenanzahl), müsste vorher die letzte verwendete Zeile ermittelt werden. Das Ganze soll mithilfe eines Buttons funktionieren, der sich sowohl auf den Quellblättern, als auch auf dem Zielblatt befindet.
Folgender Inhalt soll aus den Quellblättern übertragen werden:
Nur die Werte und Formate
Ab Zeile 18
Spalten A-T
Zielblatt
Inhalt ab Zeile 18 einfügen
Spalten A-T
Ich habe den nachfolgenden Code gefunden, der schön schnell läuft. Leider kann ich ihn nicht so modifizieren, dass er die oben genannten Bedingungen erfüllt.
Außerdem bekomme ich immer die Fehlermeldung Variable nicht definiert, wenn ich ihn in ein Button kopiere, er läuft nur in einem Modul.Ich habe auch noch andere Codes ausprobiert, habe aber etwas Zeitdruck, so dass ich mich mit meinem Problem hierher wende, in der Hoffnung jemand kann mir helfen.

Sub TabellenKopierenUntereinander()
Dim i As Integer
With ActiveWorkbook
'neue Tabelle an die erste Position einfügen
.Worksheets.Add Before:=.Worksheets(1)
For i = 2 To .Worksheets.Count
'Ermitteln den benutzen Bereich der einzelnen Tabellenblätter
Set Rng = .Worksheets(i).UsedRange
'letzte Zeile ermitteln des ersten Blattes
Set rng1 = Worksheets(1).Cells(Rows.Count, "A").End(xlUp)(2)
'Bereich kopieren
Rng.Copy Destination:=rng1
Next
End With
End Sub

Vielen Dank im Voraus!!!!
Anja

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Public Sub Zusammen() Dim loLetzte As Long, loLetzteZiel As Long Dim ws As Worksheet, wsZiel As Worksheet Application.ScreenUpdating = False Worksheets.Add Before:=Worksheets(1) ActiveSheet.Name = "Zusammenstellung" Set wsZiel = ThisWorkbook.Worksheets("Zusammenstellung") For Each ws In ThisWorkbook.Worksheets Select Case ws.Name Case "Lieferanten", "Finanzamt", "Beiträge" With ws loLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row loLetzteZiel = wsZiel.Cells(wsZiel.Rows.Count, 1).End(xlUp).Offset(1).Row If wsZiel.Cells(18, 1) = "" Then loLetzteZiel = 18 .Range(.Cells(18, 1), .Cells(loLetzte, 20)).Copy wsZiel.Cells(loLetzteZiel, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats 'wsZiel.Cells(loLetzteZiel, 1).PasteSpecial Paste:=xlPasteFormats Application.CutCopyMode = False End With Case Else End Select Next ws Set wsZiel = Nothing Application.ScreenUpdating = True End Sub

Hallo Werner,
danke für Deinen Code. Mir war nicht bewusst, dass ich es zweimal gepostet habe. Da habe ich anscheinend zu viel an den Buttons rumgespielt.
Ich habe es getestet und es funktioniert nicht so optimal.
1.
Das Tabellenblatt Zusammenstellung ist bereits vorhanden. Die Daten sollen da reingeschrieben werden. Vorher sollten die vorhanden Daten gelöscht werden.
2.
Da das TB nach ausführen des Codes immer leer war, habe ich die Bildschirmaktualisierung abgeschaltet und mir die einzelnen Schritte angesehen.
Die Daten werden reingeschrieben und danach wieder gelöscht.
Ich habe nicht soviel Ahnung, aber kann es daran liegen, dass ab Spalte L teilweise leere () Zellen vorhanden sind, die Formeln beinhalten. Soviel ich erkennen kann wird nach der letzten Zeile gesucht? Sucht er in Spalte A, weil dort eine 1 im Code steht? In Spalte A sind allerdings keine Formeln vorhanden.
Ich habe mal eine Testmappe hochgeladen, damit Du es selber probieren kannst.
https://www.herber.de/bbs/user/124151.xlsm
Liebe Grüße
Anja

Sub TabellenKopierenUntereinander() Dim i As Integer, Zei_ZL As Long, Zei_QL As Long Dim rngCopy As Range Dim wksZiel As Worksheet, wksQuelle As Worksheet With ActiveWorkbook Set wksZiel = .Worksheets("Zusammenstellung") With wksZiel 'Altdaten ab Zeile 18 löschen Zei_ZL = .UsedRange.Row + .UsedRange.Rows.Count - 1 If Zei_ZL >= 18 Then .Range(.Rows(18), .Rows(Zei_ZL)).Delete shift:=xlShiftUp End If Zei_ZL = 18 End With For i = 1 To .Worksheets.Count Set wksQuelle = .Worksheets(i) Select Case wksQuelle.Name Case "Lieferanten", "Finanzamt", "Beiträge" With wksQuelle 'Ermitteln der letzten Zeile im Tabellenblatt Zei_QL = .UsedRange.Row + .UsedRange.Rows.Count - 1 'Blatt ' Zei_QL = .cells(.Rows.Count,1).end(xlup).row 'Spalte A If Zei_QL >= 18 Then 'zu kopierenden Bereich setzen Set rngCopy = .Range(.Cells(18, 1), .Cells(Zei_QL, 20)) rngCopy.Copy wksZiel.Cells(Zei_ZL, 1).PasteSpecial xlPasteFormats wksZiel.Cells(Zei_ZL, 1).PasteSpecial xlPasteValues Zei_ZL = Zei_ZL + rngCopy Application.CutCopyMode = False End If End With Case Else 'do nothing End Select Next End With End Sub

'##########Code Franz Private Sub CommandButton2_Click() Dim i As Integer, Zei_ZL As Long, Zei_QL As Long Dim rngCopy As Range Dim wksZiel As Worksheet, wksQuelle As Worksheet With ActiveWorkbook Set wksZiel = .Worksheets("Zusammenstellung") With wksZiel 'Altdaten ab Zeile 18 löschen Zei_ZL = .UsedRange.Row + .UsedRange.Rows.Count - 1 If Zei_ZL >= 18 Then .Range(.Rows(18), .Rows(Zei_ZL)).Delete shift:=xlShiftUp End If Zei_ZL = 18 End With For i = 1 To .Worksheets.Count Set wksQuelle = .Worksheets(i) Select Case wksQuelle.Name Case "Lieferanten", "Finanzamt", "Krankenkasse", "Test" With wksQuelle 'Ermitteln der letzten Zeile im Tabellenblatt ' Zei_QL = .UsedRange.Row + .UsedRange.Rows.Count - 1 'Blatt Zei_QL = .Cells(.Rows.Count, 1).End(xlUp).Row 'Spalte A If Zei_QL >= 18 Then 'zu kopierenden Bereich setzen Set rngCopy = .Range(.Cells(18, 1), .Cells(Zei_QL, 20)) rngCopy.Copy wksZiel.Cells(Zei_ZL, 1).PasteSpecial xlPasteFormats wksZiel.Cells(Zei_ZL, 1).PasteSpecial xlPasteValues Zei_ZL = Zei_ZL + rngCopy.Rows.Count Application.CutCopyMode = False End If End With Case Else 'do nothing End Select Next End With End Sub

Beliebteste Forumthreads (12 Monate)

Meherere Tabellenblätter in ein Blätt zusammenführ

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Meherere Tabellenblätter in ein Blätt zusammenführ

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread