AW: Verschiedenen Tabellenblätter zusammenfassen
22.07.2006 21:17:34
fcs
Hallo Helmar,
hier eine Variante, die beim Aktivieren von Tabellenblättern entsprechende Aktionen im Übersichtsblatt ausführt, um die Werte aus den Zellen der Blätter in die Übersicht zu Übernehmen. Dazu wird in der Übersicht der Tabellenblattname eingetragen und entsprechende Formeln mit der Funktion INDIREKT. Das Makro muss im VBA-Editor unter "DieseArbeitsmappe" eingefügt werden.
Hier eine Beisspiel-Datei: https://www.herber.de/bbs/user/35297.xls
Gruss Franz
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim wks As Worksheet, rngTabellen As Range, rngFormeln As Range, Blatt As Worksheet
Set wks = ActiveWorkbook.Sheets("Übersicht")
With wks
Set rngTabellen = .Range(.Cells(2, 2), .Cells(2, 255)) ' Bereich mit Tabellennamen in Zeile 2
Set rngFormeln = .Range(.Cells(3, 2), .Cells(12, 255)) ' Bereich mit Formeln ab Zeile 3
End With
If Sh.Name <> wks.Name Then
'Prüfen ob Name schon in Übersicht vorhanden
For I = 1 To rngTabellen.Columns.Count
If rngTabellen(1, I) = Sh.Name Then
Exit For
Else
If rngTabellen(1, I) = "" Then
'TabellenNamen eintragen
rngTabellen(1, I) = Sh.Name
'Formeln für Wertübernahme eintragen
For J = 2 To 11
rngFormeln(J - 1, I).FormulaR1C1 = "=INDIRECT(""'""&R2C&""'!D" & J & """)"
Next
Exit For
End If
End If
Next
Else
'Tabellennamen in Übersicht neu eintragen, erforderlich wenn Tabellen umbenannt oder gelöscht werden
I = 1
For Each Blatt In ActiveWorkbook.Worksheets
If Blatt.Name <> wks.Name Then
rngTabellen(1, I) = Blatt.Name
I = I + 1
End If
Next Blatt
'nach Löschen von Tabellen nicht benötigte Tabellennamen und Formeln löschen
wks.Range(rngTabellen.Cells(1, I), rngFormeln.Cells(rngFormeln.Rows.Count, _
rngFormeln.Columns.Count)).ClearContents
End If
End Sub