Sub AddSheet()
Dim wks As Worksheet
Dim var As Variant
Application.ScreenUpdating = False
Application.DisplayAlerts = False
If ActiveCell.Column = 3 Then
var = ActiveCell.Value
Else
MsgBox "Bitte Zelle in Spalte C auswählen"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Exit Sub
End If
Set wks = Worksheets("Vorlage")
wks.Copy After:=Sheets(Sheets.Count)
On Error GoTo Err_copyWorksheetFailed
ActiveSheet.Name = var
On Error GoTo Err_RenameWorksheetFailed
Exit Sub
Err_copyWorksheetFailed:
Call MsgBox("A new worksheet could not be added.", vbCritical)
Err_RenameWorksheetFailed:
Application.DisplayAlerts = False
MsgBox "Page is still existing"
ActiveSheet.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub