Auflistung von Blättern auf ein Blatt

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Thorsten,
Teste mal diesen kleinen "Mehrzeiler":

' **********************************************************************
' Modul: Tabelle20 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Sub machs()
    Dim wbZiel As Worksheet
    Dim L As Long, K As Long, J As Long
    Dim Wb As Worksheet
    Dim arr As Variant
    Set wbZiel = Sheets("Zusammenfassung")
    K = 2
    For Each Wb In Worksheets
        If Not Wb Is wbZiel Then
            With Wb
                arr = .Range("J2", .Cells(.Rows.Count, 1).End(xlUp))
                For J = 1 To UBound(arr)
                    arr(J, 10) = Wb.Name
                Next
            End With
            wbZiel.Range("A" & K).Resize(UBound(arr), UBound(arr, 2)) = arr
            K = K + UBound(arr)
        End If
    Next
End Sub

ransi

Public Sub Zusammenfassung() Dim loLetzteQ As Long Dim loLetzteZ As Long Dim wsQuelle As Worksheet Dim wsZiel As Worksheet Set wsZiel = ThisWorkbook.Worksheets("Zusammenfassung") For Each wsQuelle In ThisWorkbook.Worksheets loLetzteZ = wsZiel.Cells(Rows.Count, 1).End(xlUp).Row + 1 If wsQuelle.Name "Zusammenfassung" Then loLetzteQ = wsQuelle.Cells(Rows.Count, 1).End(xlUp).Row If loLetzteQ > 1 Then With wsQuelle .Range(.Cells(2, 1), .Cells(loLetzteQ, 9)).Copy wsZiel.Cells(loLetzteZ, 1) wsZiel.Cells(loLetzteZ, 10) = wsQuelle.Name End With End If End If Next End Sub

Hallo Thorsten,
kannst ja auch mal das hier ausprobieren:
in ein allgemeines Modul:

Public Sub Zusammenfassung()
Dim loLetzteQ As Long
Dim loLetzteZ As Long
Dim wsQuelle As Worksheet
Dim wsZiel As Worksheet
Application.ScreenUpdating = False
Application.EnableEvents = False
Set wsZiel = ThisWorkbook.Worksheets("Zusammenfassung")
With wsZiel
loLetzteZ = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Range(.Cells(2, 1), .Cells(loLetzteZ, 10)).ClearContents
End With
For Each wsQuelle In ThisWorkbook.Worksheets
loLetzteZ = wsZiel.Cells(Rows.Count, 1).End(xlUp).Row + 1
If wsQuelle.Name  "Zusammenfassung" Then
loLetzteQ = wsQuelle.Cells(Rows.Count, 1).End(xlUp).Row
If loLetzteQ > 1 Then
With wsQuelle
.Range(.Cells(2, 1), .Cells(loLetzteQ, 9)).Copy wsZiel.Cells(loLetzteZ, 1)
wsZiel.Cells(loLetzteZ, 10) = wsQuelle.Name
End With
End If
End If
Next
Set wsZiel = Nothing
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

ins Code-Modul vom Blatt "Zusammenfassung"
Rechtsklick auf den Tabellenblattreiter - Code anzeigen - Code rechts ins Code-Fenster kopieren

Private Sub Worksheet_Activate()
Call Zusammenfassung
End Sub

Wie läuft es ab:
Sobald du von irgendeinem Blatt auf das Blatt "Zusammenfassung" wechselst wird das Makro im Modul aufgerufen. Dieses Makro leert dann zunächst das Blatt "Zusammenfassung" (bis auf die Überschriftenzeile) und kopiert dann alle Daten von allen anderen Blättern (in denen Daten vorhanden sind) ins Blatt "Zusammenfassung".
Der Code wird halt immer ausgeführt, sobald du auf das Tabellenblatt "Zusammenfassung" wechselst, egal ob in den anderen Blättern etwas geändert wurde oder nicht.
So hast du aber immer die aktuellen Daten aus den Blättern in deiner Zusammenfassung.
Gruß Werner

Beliebteste Forumthreads (12 Monate)

Auflistung von Blättern auf ein Blatt

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread