Dynamischer Bezug

Liebe Listenmitglieder,
ich stehe vor einer großen Herausforderung, bei der ihr mir vielleicht helfen könnt.
Ich habe ca. 15 einzelne Arbeitsmappen mit jeweils einem Tabellenblatt und eine Arbeitsmappe, in der alle 15 zusammengeführt werden. Der Aufbau aller Tabellenblätter ist gleich.
Wie bekomme ich es hin, dass sich bei einer Änderung im "Gesamt"-Tabellenblatt auch die entsprechende Arbeitsmappe ändert oder dass bei einer Ergänzung/Löschung im einzelnen Tabellenblatt auch das "Gesamt"-Tabellenblatt geändert wird?
Ich habe eine sehr vereinfachte Beispieldatei angehängt: https://www.herber.de/bbs/user/94286.xlsx.
Ich habe schon von den Funktionen INDIREKT und BEREICH.VERSCHIEBEN gehört, diese aber nicht verstanden.
Ich freue mich, wenn mir jemand helfen kann.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Schau mal meinst du das so... (hab aus dem Netz was kopiert und für deine Bedürfnisse angepasst

Sub Zusammenfügen()
Dim wks As Worksheet
Dim wksK As Worksheet
Dim lngLetzteZeileKons As Long
Dim lngAbZeile As Long
Application.DisplayAlerts = False
On Error Resume Next
Set wksK = ActiveWorkbook.Worksheets("Gesamt")
wksK.Delete
On Error GoTo 0
Set wksK = Worksheets.Add(Before:=ActiveWorkbook.Sheets(1))
wksK.Name = "Gesamt"
lngLetzteZeileKons = 1 'Kopieren in die zweite Zeile
For Each wks In ActiveWorkbook.Worksheets
If wks.Name  wksK.Name Then
lngAbZeile = lngLetzteZeileKons + 1
wks.Range(wks.Cells(2, 1), wks.Cells(wks.Cells.SpecialCells(xlCellTypeLastCell).Row, 254)). _
Copy _
Destination:=wksK.Cells(lngAbZeile, 2) 'wks.Range(wks.Cells(2 = ab zweiter Zeile
lngLetzteZeileKons = wksK.Cells.Find(What:="*", _
After:=wksK.Cells(1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
wksK.Range(wksK.Cells(lngAbZeile, 1), wksK.Cells(lngLetzteZeileKons, 1)) = wks.Name
End If
Next
Worksheets("Tabelle1").Rows(1).Copy Destination:=Worksheets("Gesamt").Rows(1) ' Überschrift  _
aus Tabelle1 kopieren
Selection.AutoFilter 'Autofilter setzen
Application.DisplayAlerts = True
End Sub

Sub Zusammenfügen() Dim wks As Worksheet Dim wksK As Worksheet Dim lngLetzteZeileKons As Long Dim lngAbZeile As Long Application.DisplayAlerts = False On Error Resume Next Set wksK = ActiveWorkbook.Worksheets("Gesamt") wksK.Delete On Error GoTo 0 Set wksK = Worksheets.Add(Before:=ActiveWorkbook.Sheets(1)) wksK.Name = "Gesamt" lngLetzteZeileKons = 1 'Kopieren in die zweite Zeile For Each wks In ActiveWorkbook.Worksheets If wks.Name wksK.Name Then lngAbZeile = lngLetzteZeileKons + 1 wks.Range(wks.Cells(2, 1), wks.Cells(wks.Cells.SpecialCells(xlCellTypeLastCell).Row, 254)). _ Copy _ Destination:=wksK.Cells(lngAbZeile, 2) 'wks.Range(wks.Cells(2 = ab zweiter Zeile lngLetzteZeileKons = wksK.Cells.Find(What:="*", _ After:=wksK.Cells(1), _ LookIn:=xlValues, _ LookAt:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious).Row wksK.Range(wksK.Cells(lngAbZeile, 1), wksK.Cells(lngLetzteZeileKons, 1)) = wks.Name End If Next Worksheets("Tabelle1").Range("A1:J1").Copy Destination:=Worksheets("Gesamt").Range("B1") ' Ü _ berschrift aus Tabelle1 kopieren Selection.AutoFilter 'Autofilter setzen Application.DisplayAlerts = True End Sub

Beliebteste Forumthreads (12 Monate)

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread