Benötige Makro: Zusammenführen von Tabellblättern

Hallo,
ich hoffe ihr könnt mir weiterhelfen! Und zwar benötige ich ein Makro für die folgende Situation:
Ich habe eine Exceldatei mit mehreren Tabellenblättern. Im ersten Blatt sind die Basisdaten für Drop-Down-Listen hinterlegt. In der zweiten würde ich gerne eine Auswertung der dritten machen.
Im dritten Tabellenblatt würde ich gerne die Daten, welche zwischen Tabellenblatt 4 und zum Beispiel 15 liegen sammeln. Die Daten sollen untereinander geschrieben werden. Alle diese Tabellen sind gleich aufgebaut und werden von meinen Kollegen fortlaufend gepflegt. Es handelt sich um eine Stundenliste. Wenn möglich Zeile 1 auslassen, da ich hier nur die Spaltentitel eingetragen habe.
Am Ende des Monats möchte ich, wie gesagt, diese Daten im Tabellenblatt drei sammeln, damit ich sie Auswerten kann.
Danke vorab für eure Hilfe!
Gruß
Christoph

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Danke für den Hinweis!
Ich habe das Makro mit meinen Unkenntnissen etwas umgebaut und es passiert irgenwie nix:
"Sammlung" bezeichnet das Arbeitsblatt zu dem ich alle Daten kopieren möchte...

Sub Sammlung()
Dim Zeile As Long, Spalte As Long, a As Long
Set wks = Worksheets("Sammlung")
a = 8
Application.ScreenUpdating = False
For Each ws In Worksheets
If ws.Name = "Tabelle4" And ws.Name = "Tabelle5" Then
For Zeile = 2 To ws.UsedRange.Rows.Count
'For Spalte = 1 To 13
'If Left(ws.Cells(Zeile, 2), 1) = "K" Then
'If Left(ws.Cells(Zeile, 2), 1) = "K" Or Left(ws.Cells(Zeile, 2), 1) = "k" Then
'If UCase(Left(ws.Cells(Zeile, 2), 1)) = "K" Then
' wks.Cells(a, Spalte) = ws.Cells(Zeile, Spalte)
'End If
'Next Spalte
a = wks.Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row + 1
Next Zeile
End If
Next ws
Application.ScreenUpdating = True
End Sub

Private Sub Sammlung() Dim Zeile As Long, a As Long Set wks = Worksheets("Sammlung") a = 2 ' erste Datenzeile in der Sammlung Application.ScreenUpdating = False For Each ws In Worksheets If ws.Name "Daten" And ws.Name "Sammlung" And ws.Name "AUswerung" Then For Zeile = 2 To ws.UsedRange.Rows.Count If ws.Cells(Zeile, 1) "" Then ws.Cells(Zeile, 1).EntireRow.Copy wks.Cells(a, 1).PasteSpecial Paste:=xlPasteValues wks.Cells(a, 1).PasteSpecial Paste:=xlPasteFormats a = a + 1 Else ' hier kann man sagen, dass ab der ersten leeren Zeile ' nicht mehr weitergesucht werden muss: GoTo NächstesBlatt End If Next Zeile End If NächstesBlatt: Next ws Application.CutCopyMode = False Application.ScreenUpdating = True End Sub

Beliebteste Forumthreads (12 Monate)

Benötige Makro: Zusammenführen von Tabellblättern

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread