AW: Makro wenn Zellwert sich ändert
08.12.2020 20:19:42
Werner
Hallo,
den Code im Blatt "Deckblatt Pos 1-4" komplett löschen und durch den hier ersetzen.
Option Explicit
Private 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 = Replace(Target.Cells(1, 1), "/", "")
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!"
Target.Select
Exit Sub
End If
Next
Application.ScreenUpdating = False
With Worksheets("Tabblatt kopieren")
.Visible = xlSheetVisible
.Copy Before:=Worksheets("Tabblatt kopieren")
.Visible = xlSheetVeryHidden
End With
ActiveSheet.Name = mstrSheetname
End If
Else
For Each ws In ThisWorkbook.Worksheets
If ws.Name = mstrSheetname Then
Application.DisplayAlerts = False
ws.Delete
Exit For
End If
Next ws
End If
Case Else
End Select
End If
Worksheets("Deckblatt Pos 1-4").Select
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 5 Then
Select Case Target.Row
Case 12, 18, 24, 30
mstrSheetname = Replace(Target.Cells(1, 1), "/", "")
Case Else
End Select
End If
End Sub
Die Hilfsspalten H und I brauchts du jetzt nicht mehr.
Gruuß Werner