Tabellenblätter mit Inhaltsverzeichnis löschen | Herbers Excel-Forum

Hallo
Ich suche seit geraumer Zeit nach der Lösung folgenden Problems:
Ich arbeite mit einer Arbeitsmappe mit ca. 100 verschiedenen Tabellenblättern. Für jede Einzelarbeit brauche ich davon ca. 10-30 Blätter. Die nicht benötigten Blätter möchte ich mittels Makro am Ende löschen.
Mittels eines Addins wird das vorderste Tabellenblatt mit den Namen "Inhaltsverzeichnis" erstellt, in dem in den Zellen A3 bis A102 die Tabellenblattnamen aller Arbeitsblätter aufgelistet sind. Die Namen sind gleichzeitig Hyperlink zu den gleichnamigen Arbeitsblatt.
Nun möchte ich mittels Markieren der Zeilen mit dem Blattnamen im Tabellenblatt "Inhaltsverzeichnis" das verlinkte Tabellenblatt und die betreffende Zeile (nicht nur Zelle) im Tabellenblatt "Inhaltsverzeichnis" löschen.
Ich habe selbst schon gesucht und probiert, aber es gelingt mir nicht, das jeweils neu angewählte Worksheet "Blattname" in die Formel zu bekommen. Es bleibt immer das vorhergehende (gelöschte) dort stehen und damit geht es einfach nicht. Beipiel (aber bitte nicht lachen - VBA Anfänger)

Sub Makro3()
' Makro3 Makro
ActiveCell.Select
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Sheets("Blattname").Select
ActiveWindow.SelectedSheets.Delete
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("Inhaltsverzeichnis").Select
ActiveCell.Rows("1:1").EntireRow.Select
Selection.Delete Shift:=xlUp
End Sub

oder

Sub Tabellenlätter_löschen_H1()
Application.DisplayAlerts = False
Selection.EntireRow.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Sheets("Blattname").Select
ActiveWindow.SelectedSheets.Delete
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("Inhaltsverzeichnis").Select
Selection.Delete Shift:=xlUp
Range("A2").Select
Application.DisplayAlerts = True
End Sub

Kann mir da jemand helfen? Das würde mich sehr freuen, weil ich diesen Vorgang relativ oft - noch ?- händisch durchführe (aufwendiges Einzelblattlöschen).
Viele Grüsse
Heinz

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Workbook_SheetBeforeDoubleClick(ByVal sh As Object, _ ByVal Target As Range, Cancel As Boolean) Dim yn As Boolean Cancel = True yn = MsgBox("Worksheet '" & Target.Value & _ "' wirklich löschen?!", vbYesNo + _ vbCritical, "Tabellen löschen") Application.DisplayAlerts = False Sheets(Target.Value).Select ActiveWindow.SelectedSheets.Delete Application.DisplayAlerts = True Sheets(sh.Name).Select Rows(Target.Row).Delete End Sub

Hallo Jochen
könnte doch klappen. Ich bin nur den Doppelclick nicht mehr gewohnt, weil ich alles mit Einfachklick mache.
Es hat mit Doppelclick auf den Link in der Spalte A des Tabellenblattes "Inhaltsverzeichnis" einige male funkioniert, daß nach Aufpoppen der MsgBox und der Bestätigung "ja, wirklich löschen" sowohl die Zeile
im Blatt "Inhaltsverzeichnis" und das angewählte Arbeitsblatt gelöscht waren. Jetzt bleibt er aber meist nach der MsgBox hängen und der Debugger weist auf die Zeile Sheets(Target.Value).Select und sagt "Index außerhalb des gültigen Bereiches". Eine gewisse Tücke hat auch der Doppelclick auf den Hyperlink -zu langsam, dann öffnet sich das angewählte Blatt, zu schnell und ein falsches Blatt ist weg. Aber die Zielrichtung könnte doch stimmen.
Da ich ich oft auch 30 (bis zu 80) Zeilen/Blätter aufeinanderfolgend löschen muß wäre mein Wunsch, daß ich z.B. 30-80 Zeilen markiere, dann auf einen Schaltbottom drücke und die 30-80 Zeilen und die 30-80 Blätter wären mit einem Klick weg.
Meinst Du, das wäre machbar?
Vielen Dank für die Mühe
Heinz

Sub BlaetterLoeschen() Dim rngSelektion As Range, Zeile As Range, lNr As Long, _ strBlatt As String, arrZeilen() As Long, arrBlatt() As String lNr = 0 If MsgBox("Blätter in markierten Zeilen Löschen?", vbQuestion + vbYesNo, _ "Blätter Löschen") = vbYes Then 'Daten der zulöschenden Blätter einlesen Set rngSelektion = Selection For Each Zeile In rngSelektion.Rows If Zeile.Row >= 3 And _ fncCheckSheet(ActiveWorkbook, Worksheets(1).Cells(Zeile.Row, 1).Text) = True Then lNr = lNr + 1 ReDim Preserve arrZeilen(1 To lNr) ReDim Preserve arrBlatt(1 To lNr) arrZeilen(lNr) = Zeile.Row arrBlatt(lNr) = Worksheets(1).Cells(Zeile.Row, 1) Else 'Blatt mit Name in Spalte A ist nicht vorhanden Worksheets(1).Cells(Zeile.Row, 2) = "Blatt nicht vorhanden" End If Next If lNr > 0 Then Application.ScreenUpdating = False 'Blätter löschen Application.DisplayAlerts = False ActiveWorkbook.Sheets(arrBlatt).Delete Application.DisplayAlerts = True 'Zeilenlöschen For lNr = lNr To 1 Step -1 Worksheets(1).Rows(arrZeilen(lNr)).Delete shift:=xlShiftUp Next Application.ScreenUpdating = True End If End If End Sub Function fncCheckSheet(wb As Workbook, varBlatt) As Boolean 'Prüft ob Blatt in Arbeitsmappe vorhanden Dim objSheet As Object For Each objSheet In wb.Sheets If objSheet.Index = varBlatt Or LCase(objSheet.Name) = LCase(varBlatt) Then fncCheckSheet = True Exit For End If Next End Function

Beliebteste Forumthreads (12 Monate)

Tabellenblätter mit Inhaltsverzeichnis löschen | Herbers Excel-Forum

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

288 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Tabellenblätter mit Inhaltsverzeichnis löschen | Herbers Excel-Forum

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

288 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread