Blätter aus Layouttabelle erstellen

Sub FilterSetzenUndBlattKopieren(intSpalte As Integer)
With Application
.ScreenUpdating = False
.DisplayAlerts = False
.Calculation = xlCalculationManual
End With
Dim wksDieses As Worksheet
Dim strBlattname As String
Dim intZaehler As Integer
Dim rngDieser As Range
Dim strAusgangstabelle As String
Dim strZielTabelle As String
Dim lstObjekte As ListObject
Dim btnSchaltflaeche As Button
'Zunächst alle evtl. vorhandenen Blätter löschen
BlaetterLoeschen
Set wksDieses = tabDaten
Set rngDieser = tabDaten.UsedRange
Set rngDieser = rngDieser.Offset(1).Resize(rngDieser.Rows.Count - 1)
strAusgangstabelle = wksDieses.ListObjects.Item(1) & ""
For intZaehler = 1 To rngDieser.Rows.Count
strBlattname = rngDieser.Cells(intZaehler, intSpalte)
If BlattVorhanden(strBlattname) = False Then
wksDieses.ListObjects(strAusgangstabelle).Range.AutoFilter Field:=intSpalte, Criteria1:=strBlattname
wksDieses.Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = strBlattname
ActiveSheet.Tab.Color = RGB(220, 220, 220)
AusgeblendeteZeilenLoeschen
'      For Each btnSchaltflaeche In ActiveSheet.Buttons
'        btnSchaltflaeche.Delete
'      Next
End If
Next intZaehler
wksDieses.ListObjects(strAusgangstabelle).Range.AutoFilter
wksDieses.Activate
FilterEntfernen
With Application
.ScreenUpdating = True
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
End With
End Sub

Sub AusgeblendeteZeilenLoeschen()
Application.DisplayAlerts = False
Dim i
For i = ActiveSheet.UsedRange.Row To ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count
If ActiveSheet.Rows(i).Hidden Then
ActiveSheet.Rows(i).Delete
i = i - 1
End If
Next
Application.DisplayAlerts = True
End Sub

Sub BlaetterSortieren()
Dim intBlatt As Integer
Dim intBlattStart As Integer
Dim blnGetauscht As Boolean
Dim wksDieses As Worksheet
Application.ScreenUpdating = False
intBlattStart = 1
For Each wksDieses In Worksheets
If Len(wksDieses.Name) > 2 Then
intBlattStart = intBlattStart + 1
End If
Next wksDieses
Set wksDieses = ActiveSheet
Do
blnGetauscht = False
For intBlatt = intBlattStart To Sheets.Count - 1
If Sheets(intBlatt).Name > Sheets(intBlatt + 1).Name Then
'Tauschen
Sheets(intBlatt).Move after:=Sheets(intBlatt + 1)
'getauscht setzen
blnGetauscht = True
End If
Next intBlatt
Loop Until Not blnGetauscht
wksDieses.Activate
Application.ScreenUpdating = False
End Sub

Sub BlaetterLoeschen()
Dim wksDieses As Worksheet
On Error Resume Next
If MsgBox("Sind Sie sicher? Alle bestehenden Blätter außer 'Start' & 'Daten' werden gelöscht.", vbYesNo +  _
vbDefaultButton2, p_cstrAppnameVersion & " - Blätter löschen") = vbYes Then
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each wksDieses In Worksheets
If wksDieses.CodeName  "tabStart" And wksDieses.CodeName  "tabDaten" Then
wksDieses.Delete
End If
Next wksDieses
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub