AW: Makro Tabblatt löschen
21.01.2021 20:25:49
Mildred
Hallo Yal,
vielen Dank für deine Hilfe. Leider kenne ich mich mit Makros nicht sehr gut. Deswegen weiß ich nicht, was du mit
"die Initialisierung der Variable Nam findet nach dem If statt, aber diese Variable wird im Else verwendet. Versetze die Initialisierung vor dem If."
und
"Auslagern von Code-Wiederholungen in "separaten sub/Functionin"
meinst.
Ich habe den Code versucht anhand deiner Angaben zu verändern (fett markiert), es hat sich allerdings nichts geändert. 2 Blätter werden gelöscht, der Rest dann nicht mehr, obwohl der Inhalt der Zellen geleert wird. Der komplette Code sieht jetzt wie folgt aus:
Option Explicit
Dim Nam As String
Dim mstrSheetname As String
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim Fehler As Integer, ws As Object
If Target.Column = 5 Then
Select Case Target.Row
Case 12, 18, 24, 30
If Not IsEmpty(Target.Cells(1, 1).Value) Then
mstrSheetname = Left(Replace(Target.Cells(1, 1), "/", " "), 30)
If MsgBox("Tabelenblatt mit Name """ & Target.Text & """ anlegen ?", _
vbYesNo, "Blatt Vorlage kopieren") = vbYes Then
For Each ws In ThisWorkbook.Worksheets
If ws.Name = mstrSheetname Then
MsgBox "Blatt mit dem eingegeben Namen " & mstrSheetname _
& " existiert bereits!"
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
Target.Offset(1).Select
Exit Sub
End If
Next
Application.ScreenUpdating = False
With Worksheets("Kalkulationsvorlage")
.Visible = xlSheetVisible
.Copy Before:=Worksheets("Kalkulationsvorlage")
.Visible = xlSheetVeryHidden
End With
ActiveSheet.Name = mstrSheetname
End If
Else
If WS_exists(mstrSheetname) Then Blatt_loeschen (mstrSheetname)
End If
Case Else
End Select
End If
If Target.Column = 5 Then
Select Case Target.Row
Case 17, 23, 29, 35
If Not IsEmpty(Cells(Target.Row, 5).Value) Then
Nam = Left(Replace("ICTP " & Cells(Target.Row - 5, 5), "/", " "), 25)
If MsgBox("Tabellenblatt mit Name " & Nam & " anlegen ?", _
vbYesNo, "Blatt Vorlage kopieren") = vbYes Then
For Each ws In ThisWorkbook.Worksheets
If ws.Name = Nam Then
MsgBox "Blatt mit dem eingegeben Namen " & Nam _
& " existiert bereits!"
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
Target.Offset(1).Select
Exit Sub
End If
Next
Application.ScreenUpdating = False
With Worksheets("PRELIMINARY STANDARD")
.Visible = xlSheetVisible
.Copy Before:=Worksheets("PRELIMINARY STANDARD")
.Visible = xlSheetVeryHidden
End With
ActiveSheet.Name = Nam
End If
Else
If WS_exists(Nam) Then Blatt_loeschen (Nam)
End If
Case Else
End Select
End If
Worksheets("Deckblatt Pos 1-4").Select
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim mstrSheetname As String
Dim Nam As String
If Target.Column = 5 Then
Select Case Target.Row
Case 12, 18, 24, 30
mstrSheetname = Left(Replace(Target.Cells(1, 1), "/", " "), 30)
Case Else
End Select
End If
If Target.Column = 5 Then
Select Case Target.Row
Case 17, 23, 29, 35
Nam = Left(Replace("ICTP " & Cells(Target.Row - 5, 5), "/", " "), 25)
Case Else
End Select
End If
End Sub
Private Function WS_exists(BlattName As String) As Boolean
'Gibt falsch zurück, wenn WS nicht existiert
On Error Resume Next
WS_exists = Len(Worksheets(BlattName).Name) > 0
End Function
Private Sub Blatt_loeschen(BlattName As String, Optional Mitbetätigung = True)
Dim Cancel As Boolean
If Mitbetätigung Then
Cancel = Not (MsgBox("Tabellenblatt mit Name """ & BlattName & """ wirklich löschen ?", _
_
vbYesNo) = vbYes)
End If
If Not Cancel Then
Application.DisplayAlerts = False
Worksheets(BlattName).Delete
Application.DisplayAlerts = True
End If
End Sub
V.G. Mildred