Excel Makro um Tabellenblätter zu löschen

Forumthread: Excel Makro um Tabellenblätter zu löschen

01.09.2023 11:01:49

SvenR

Hallo zusammen,

ich benötige ein Makro, dass mir Tabellenblätter aus der Arbeitsmappe löscht, die nicht in einer Spalte (beginnend mit J9) stehen. D.h. in der Tabelle gibt es viele Tabellenblätter und ich möchte nur das aktive und die behalten, die in der Liste stehen.

Ich habe bereits die Suche verwendet und folgendes Makro gefunden:

Option Explicit

Sub Loeschen()

' Alle Register löschen bis auf Register Tabelle1

Dim I As Integer

Application.ScreenUpdating = False

Application.DisplayAlerts = False

For I = ActiveWorkbook.Worksheets.Count To 1 Step -1

Select Case UCase(Worksheets(I).Name)

Case "TABELLE1", "TABELLE2", "TABELLE3", "TABELLE4", _

"TABELLE5", "TABELLE6", "TABELLE7"

Case Else

Worksheets(I).Delete

End Select

Next I

Application.ScreenUpdating = True

Application.DisplayAlerts = True

End Sub

https://www.herber.de/forum/archiv/1176to1180/1179923_Tabellenblaetter_loeschen_aber_nicht_alle.html

Jedoch bezieht sich dies auf festdefinierte Namen und ich bekomme es nicht gebacken, das Makro so zu ändern, dass es sich dynamisch auf die Spalte bezieht.
Vielen Dank für eure Mühen schon einmal vorab!

Viele Grüße
Sven

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

AW: Excel Makro um Tabellenblätter zu löschen

01.09.2023 13:27:59

Ulf

AW: Excel Makro um Tabellenblätter zu löschen

01.09.2023 13:27:59

Ulf



Option Explicit



Private colBlätter As New Collection



Public Sub Loeschen()

    ' Alle Register löschen bis auf Register Tabelle1

    Dim I As Integer

    Application.ScreenUpdating = False

    Application.DisplayAlerts = False

    leseBlätter

    For I = ActiveWorkbook.Worksheets.Count To 1 Step -1

        If Not nichtlöschbar(Worksheets(I).Name) Then

            Worksheets(I).Delete

        End If

    Next I

    Application.ScreenUpdating = True

    Application.DisplayAlerts = True

End Sub



Private Sub leseBlätter()

    Dim wksNamen As Worksheet

    Dim strAdr As String

    Dim rg As Range, c As Range

    Set wksNamen = ActiveWorkbook.Worksheets("Tabelle1")

    strAdr = wksNamen.Range("J9").SpecialCells(xlCellTypeLastCell).AddressLocal

    Set rg = wksNamen.Range("$J$9:" & strAdr)

    For Each c In rg

        colBlätter.Add c.Value

    Next

End Sub



Private Function nichtlöschbar(ByVal strBlatt As String) As Boolean

    Dim bRet As Boolean

    Dim varNicht As Variant

    For Each varNicht In colBlätter

        If strBlatt = varNicht Then

            bRet = True

            Exit For

        End If

    Next

    nichtlöschbar = bRet

End Function

hth
Ulf

Beliebteste Forumthreads (12 Monate)

Excel Makro um Tabellenblätter zu löschen

Forumthread: Excel Makro um Tabellenblätter zu löschen

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread