VBA kode

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Svar As String
Dim CorrectAnswer As Boolean
If ActiveSheet.Name = "std. ark" Then
    Do
    Svar = InputBox("Ændre navnet:  (std. ark) til:", "Du skal ændre Ark navnet:")
        If Svar = "" Then
            CorrectAnswer = False
            MsgBox "Det var skidt - men vi prøver bare igen!"
        Else
            CorrectAnswer = True
            Sheets("std. ark").Name = Svar
            Exit Do
        End If
    Loop
End If
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If Sheets(1).Name = "std. ark" Then
    MsgBox ActiveWorkbook.Name & vbCrLf _
    & vbCrLf & _
    " kan ikke gemmes !!!"
    Cancel = True
    End If
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Sheets(1).Name = "std. ark" Then
    Dim Svar As Integer
    Svar = MsgBox("Filen kan ikke gemmes," & vbCrLf _
    & vbCrLf & _
    "vil du lukke uden at gemme?", vbYesNo, "Advarsel")
    If Svar = vbYes Then
    ElseIf Svar = vbNo Then
    Cancel = True
    End If
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If ActiveSheet.Name = "std. ark" Then Call Opret_Kopi
End Sub

Sub Opret_Kopi()
Dim Svar1 As String
Dim Svar2 As String
Dim CorrectAnswer As Boolean
Dim Ark_Navn As String

If ActiveSheet.Name = "std. ark" Then

    Svar1 = MsgBox("Du kan nu oprette en kopi, af 'std. ark'" & vbCrLf _
    & vbCrLf & _
    "Vil du oprette en kopi?", vbYesNo, "Advarsel")
    If Svar1 = vbYes Then
    Sheets("std. ark").Copy After:=Sheets(1)
   
        Do
            Svar2 = InputBox("Ændre navnet:  (std. ark) til:", "Du skal ændre Ark navnet:")
            If Svar2 = "" Then
                CorrectAnswer = False
                MsgBox "Det var skidt - men vi prøver bare igen!"
            Else
                CorrectAnswer = True
                    Ark_Navn = Svar2
                    If (Sheet_Exists(Ark_Navn) = False) Then
                    ActiveSheet.Name = Svar2
                    Exit Do
                    End If
                CorrectAnswer = False
                MsgBox "Arket:" & vbCrLf _
                & vbCrLf & _
                " - " & Svar2 & " - " & vbCrLf _
                & vbCrLf & _
                "findes allerede - men vi prøver bare igen!"
            End If
        Loop
   
    ElseIf Svar1 = vbNo Then
    Cancel = True
    End If
End If
End Sub

Function Sheet_Exists(WorkSheet_Name As String) As Boolean
    Dim Work_sheet As Worksheet
    Sheet_Exists = False
    For Each Work_sheet In ThisWorkbook.Worksheets
        If Work_sheet.Name = WorkSheet_Name Then
            Sheet_Exists = True
        End If
    Next
End Function