Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1384to1388
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

Inhalte von Tabellenblätter untereinander

Inhalte von Tabellenblätter untereinander
02.10.2014 15:19:45
Tabellenblätter
Hallo,
ich habe eine Mappe mit ca. 30 Tabellenblättern.
Aus diesen Tabellenblättern möchte ich gerne Daten zusammenführen.
Dazu sollen in einem neuen Tabellenblatt "Tabellenliste" die Namen der Tabellenblätter untereinander stehen, deren Daten alle auf ein Tabellenblatt "Zusammenfassung" importiert werden. Im Script möchte ich dazu je Tabellen eine gültige Start- und Endespalte angeben, bspw. D und AX und eine Startzeile bspw. 8
Tabelle1 D AX 8
Tabelle4 D AX 12
Tabelle6 E AY 5
.
.
.
Das Script soll nun aus allen aufgelisteten Tabellen beginnend mit Tabelle 1 alle Werte von D8 bis letzte gefüllte Zelle in Spalte AX in die Tabelle "Zusammenfassung" ab B1 kopieren. Danach das Gleiche mit Tabellle 4 D12 bis AX Ende, Tabelle 6 E5 bis AY ende etc. und alle Blöcke untereinander schreiben.
Kann mir bitte jemand dabei helfen.
Gruß
Hans

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
VBA-Sammler
02.10.2014 17:17:09
Erich
Hi Hans,
probiers mal damit:

Option Explicit
Sub Sammler()
Dim arW(1 To 35) As String, arV(1 To 35) As String, ii As Long, cc As Long
Dim arB(1 To 35) As String, arZ(1 To 35) As Long, zz As Long, qq As Long
ii = ii + 1: arW(ii) = "Tabelle1": arV(ii) = "D": arB(ii) = "AX": arZ(ii) = 8
ii = ii + 1: arW(ii) = "Tabelle4": arV(ii) = "D": arB(ii) = "AX": arZ(ii) = 12
ii = ii + 1: arW(ii) = "Tabelle6": arV(ii) = "E": arB(ii) = "AY": arZ(ii) = 5
zz = 1                                 ' 1. Zielzeile
For ii = 1 To UBound(arW)              ' Schleife über Blätter
If arW(ii) = "" Then Exit For
With Sheets(arW(ii))
qq = .Cells(.Rows.Count, arV(ii)).End(xlUp).Row - arZ(ii) + 1
cc = Range(arV(ii) & ":" & arB(ii)).Columns.Count
Sheets("Zusammenfassung").Cells(zz, 2).Resize(qq, cc) = _
.Cells(arZ(ii), arV(ii)).Resize(qq, cc).Value2
zz = zz + qq
End With
Next ii
End Sub
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

Anzeige
AW: VBA-Sammler
02.10.2014 17:59:57
stormlamp
Hallo Erich,
im Ansatz funktioniert es, jedoch noch nicht ganz.
Einmal würde ich gerne die Werte, die jetzt fest im Code stehen:

ii = ii + 1: arW(ii) = "Tabelle1": arV(ii) = "D": arB(ii) = "AX": arZ(ii) = 8
ii = ii + 1: arW(ii) = "Tabelle4": arV(ii) = "D": arB(ii) = "AX": arZ(ii) = 12
ii = ii + 1: arW(ii) = "Tabelle6": arV(ii) = "E": arB(ii) = "AY": arZ(ii) = 5
wie geschrieben aus einem Tabellenblatt "Tabellenliste" einlesen,
in der Spalte A stehen die Tabellennamen, in Spalte B die Startspalte, in C die Endspalte und in D die Startzeile.
Die erste Tabelle wird komplett und richtig übertragen, aber ab dem zweiten Tabellenblatt fehlt bei jeder Übertragung das erste Zeichen, das jeweils eine "0" ist. Es werden die Formate nicht mitgenommen. Wenn ich in der Zieltabelle die Spalte als Text vorab definiere, dann wird die führende "0" mitgenommen.
Letzte Frage: Wo steht die Zielstelle "B1", wenn ich das einmal variieren möchte?
Gruß
Hans

Anzeige
VBA-Sammler 2
03.10.2014 01:24:37
Erich
Hi Hans,
dann probiers mal hiermit:

Option Explicit
Sub Sammler2()
Dim arW, ii As Long, cc As Long, zz As Long, qq As Long
With Sheets("Tabellenliste")                             ' Vorgabeliste
arW = .Cells(1, 1).Resize(.Cells(.Rows.Count, 1).End(xlUp).Row, 4)
End With
zz = 1                                                   ' 1. Zielzeile
For ii = 1 To UBound(arW)                                ' Schleife über Blätter
If arW(ii, 1)  "" Then
With Sheets(arW(ii, 1))
qq = .Cells(.Rows.Count, arW(ii, 2)).End(xlUp).Row - arW(ii, 4) + 1
cc = Range(arW(ii, 2) & ":" & arW(ii, 3)).Columns.Count
.Cells(arW(ii, 4), arW(ii, 2)).Resize(qq, cc).Copy _
Sheets("Zusammenfassung").Cells(zz, 2)       ' Zielspalte 2 = B
zz = zz + qq                                    ' neue Zielzeile zz
End With
End If
Next ii
End Sub
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

Anzeige
Gelöst: VBA-Sammler 2
03.10.2014 09:11:16
stormlamp
Hallo Erich,
vielen Dank für die Hilfe und das tolle Script es funktioniert perfekt und lässt sich nun auch ausgezeichnet auf verschiedene Konstellationen anpassen.
Auch die Formatierungen kommen jetzt sauber mit rüber.
Ein Hindernis habe ich noch festgestellt:
Wenn auf einem Tabellenblatt ein Filter gesetzt ist, dann werden nur die gefilterten Zeilen kopiert.
Lässt sich das umgehen oder muss ich vorher manuell alle Auofilter zurücksetzen, dass keine Werte mehr ausgefiltert werden und auch alle Zeilen kopiert werden?
Freundliche Grüße
Hans

AutoFilter ausschalten
03.10.2014 10:52:12
Erich
Hi Hans,
du kannst den AutoFilter auch auschalten lassen. Ergänz doch mal im Code
die zweite folgende Zeile:

With Sheets(arW(ii, 1))
If .AutoFilterMode Then .AutoFilterMode = False ' Autofilter ausschalten
qq = .Cells(.Rows.Count, arW(ii, 2)).End(xlUp).Row - arW(ii, 4) + 1

Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich und: Schönen Feiertag, schönes WoEnde allerseits!

Anzeige
AW: AutoFilter ausschalten
03.10.2014 22:19:28
stormlamp
Hall Erich,
den Autoschalter habe ich mit diesem Code schon ausgeschaltet:
Dim ws  As Worksheet
For Each ws In ActiveWorkbook.Worksheets
If ws.FilterMode Then
ws.ShowAllData
End If
Next ws
Das mache ich allerdings ungerne, da in allen Tabellen die Autofilter anders eingestellt sind und anschließend wieder alle zu Fuß gesetzt werden müssen. Ich hatte gehofft, es gibt einen Code, alle gefüllten Zeilen zu kopieren, auch wenn ein Teil durch Autofilter ausgeblendet ist.
Jedenfalls vielen Dank und ein schönes Wochenende
Hans

301 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige