25.07.2017, 14:31
Hallo, bitte um Unterstützung - Danke!
Habe folgende Excel Datei - ich führe ein Einnahmen/Ausgabenjournal, in einer Tabelle "Bank" werden die Bankbewegungen verbucht, in einer weiteren Tabelle die "Bar-Einnahmen" sowie in einer weiteren Tabelle die "Bar-Ausgaben". In dieser Datei befinden sich weitere Tabellen. Ich möchte die Datensätze der drei angeführten Tabellen "Bank, Bar-Einnahmen und Bar-Ausgaben"
in eine Tabelle zusammenführen. Alle drei Tabellen sind gleich aufgebaut. Die Datensätze beginnen jeweils mit A7 bis M7 (Spalten A bis M) - ca. 1000 Datensätze. Habe in einem Forum nachfolgendes Makro gefunden.
Es funktioniert einwandfrei, aber nicht auf meine drei Tabellen bezogen.
Kann mir jemand vielleicht weiterhelfen?
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
Habe folgende Excel Datei - ich führe ein Einnahmen/Ausgabenjournal, in einer Tabelle "Bank" werden die Bankbewegungen verbucht, in einer weiteren Tabelle die "Bar-Einnahmen" sowie in einer weiteren Tabelle die "Bar-Ausgaben". In dieser Datei befinden sich weitere Tabellen. Ich möchte die Datensätze der drei angeführten Tabellen "Bank, Bar-Einnahmen und Bar-Ausgaben"
in eine Tabelle zusammenführen. Alle drei Tabellen sind gleich aufgebaut. Die Datensätze beginnen jeweils mit A7 bis M7 (Spalten A bis M) - ca. 1000 Datensätze. Habe in einem Forum nachfolgendes Makro gefunden.
Es funktioniert einwandfrei, aber nicht auf meine drei Tabellen bezogen.
Kann mir jemand vielleicht weiterhelfen?
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
