Går i selvsving hvis flere filer åbne

Hvis 2 filer er åbne med koden her, kan jeg ikke afslutte excel på kryds  øverste højre hjørne.Excel spørger i gen og igen om filen skal gemmes?
virker fint hvis kun en fil åben.
___________________________________________________
Private Const UdenMakroArk = "Ark1"
Private Sub Workbook_Open()
If Application.ActiveWorkbook.Name <> ThisWorkbook.Name Then
Exit Sub
ElseIf Application.ActiveWorkbook.Name = ThisWorkbook.Name Then
Application.ScreenUpdating = False
ActiveWorkbook.Unprotect Password:="x"
ActiveWorkbook.Names("MyOrigPlace").Delete
On Error Resume Next
For Each ws In Sheets
    ws.Visible = True
Next ws
If ThisWorkbook.Sheets.Count > 1 Then Sheets(UdenMakroArk).Visible = xlSheetVeryHidden
With Application
.OnKey "^c", "" 'Copy shortcut disabled
.OnKey "^v", "" 'Paste shortcut disabled
.OnKey "^x", "" 'Cut shortcut disabled
.OnKey "^p", "" 'Print shortcut disabled
.CellDragAndDrop = False
End With
'-------------- gå til ark1 ---------------------------------
    Sheets("ark1").Select
    ActiveWindow.ScrollRow = 1
    ActiveWindow.ScrollColumn = 1
    ActiveSheet.Unprotect Password:="x"
'    ActiveWindow.DisplayWorkbookTabs = False
'    Range("AI4:AI38").ClearContents
'    Range("C4,C6,C8,C10,C12,C14,C16,C18,C20,C22,C24,C26").Style = "1 Udgift"
'    Range("C5,C7,C9,C11,C13,C15,C17,C19,C21,C23,C25").Style = "2 Udgift"
'    Range("D4:O4,D6:O6,D8:O8,D10:O10,D12:O12,D14:O14,D16:O16,D18:O18,D20:O20,D22:O22,D24:O24,D26:O26").Style = "1 beløb"
'    Range("D5:O5,D7:O7,D9:O9,D11:O11,D13:O13,D15:O15,D17:O17,D19:O19,D21:O21,D23:O23,D25:O25").Style = "2 beløb"
'    Range("P4:Q4,P6:Q6,P8:Q8,P10:Q10,P12:Q12,P14:Q14,P16:Q16,P18:Q18,P20:Q20,P22:Q22,P24:Q24,P26:Q26").Style = "1 total"
'    Range("P5:Q5,P7:Q7,P9:Q9,P11:Q11,P13:Q13,P15:Q15,P17:Q17,P19:Q19,P21:Q21,P23:Q23,P25:Q25").Style = "2 total"
'    Range("C33,C35,C37").Style = "1 Udgift"
'    Range("C34,C36,C38").Style = "2 Udgift"
'    Range("D33:O33,D35:O35,D37:O37").Style = "1 beløb"
'    Range("D34:O34,D36:O36,D38:O38").Style = "2 beløb"
'    Range("P33:Q33,P35:Q35,P37:Q37").Style = "1 total"
'    Range("P34:Q34,P36:Q36,P38:Q38").Style = "2 total"
    Application.Goto Reference:="R200C22" '.....gå til V200.....
    ActiveWindow.ScrollRow = 1
    ActiveWindow.ScrollColumn = 1
    ActiveSheet.Protect Password:="x"
    ActiveWorkbook.Protect Password:="x", Structure:=True, Windows:=True
    Application.ScreenUpdating = True
    End If
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If Application.ActiveWorkbook.Name <> ThisWorkbook.Name Then
Exit Sub
ElseIf Application.ActiveWorkbook.Name = ThisWorkbook.Name Then
Dim txtFileName As String

'1. Check of Save As was used.
  If SaveAsUI = True Then 'true= save as
      Cancel = True

'2. Call up your own dialog box.  Cancel out if user Cancels in the dialog box.(save as valgt)
      txtFileName = Application.GetSaveAsFilename(, "Excel Macro-Enabled Workbook (*.xlsm), *.xlsm", , "Save As XLSM file")
      If txtFileName = "False" Then
      MsgBox "Action Cancelled", vbOKOnly
      Cancel = True
Else
      Application.ScreenUpdating = False
      ActiveWorkbook.Names.Add Name:="MyOrigPlace", RefersTo:=Selection
      ActiveWorkbook.Unprotect Password:="x"
For Each ws In Sheets
            If ThisWorkbook.Sheets.Count > 1 Then
                If ws.Name = UdenMakroArk Then
                    ws.Visible = xlSheetVisible
                Else
                    ws.Visible = xlSheetVeryHidden
                End If
            End If
        Next ws
        ActiveWindow.ScrollRow = 1
        ActiveWindow.ScrollColumn = 1
        Application.Goto Reference:="R35C1"
        ActiveWorkbook.Protect Password:="x", Structure:=True, Windows:=False
        Application.EnableEvents = False
        ThisWorkbook.SaveAs Filename:=txtFileName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
        Application.EnableEvents = True
        ActiveWorkbook.Unprotect Password:="x"
        On Error Resume Next
For Each ws In Sheets
    ws.Visible = True
Next ws
If ThisWorkbook.Sheets.Count > 1 Then Sheets(UdenMakroArk).Visible = xlSheetVeryHidden
        Application.Goto Reference:="MyOrigPlace"
        ActiveWorkbook.Names("MyOrigPlace").Delete
        ActiveWorkbook.Protect Password:="x", Structure:=True, Windows:=True
        Application.ScreenUpdating = True
        Exit Sub
End If
   
'3. Save the file.(save valgt)
Else
        Cancel = True
        Application.ScreenUpdating = False
        ActiveWorkbook.Names.Add Name:="MyOrigPlace", RefersTo:=Selection
        ActiveWorkbook.Unprotect Password:="x"
For Each ws In Sheets
            If ThisWorkbook.Sheets.Count > 1 Then
                If ws.Name = UdenMakroArk Then
                    ws.Visible = xlSheetVisible
                Else
                    ws.Visible = xlSheetVeryHidden
                End If
            End If
        Next ws
        ActiveWindow.ScrollRow = 1
        ActiveWindow.ScrollColumn = 1
        Application.Goto Reference:="R35C1"
        ActiveWorkbook.Protect Password:="x", Structure:=True, Windows:=False
        Application.EnableEvents = False
        ThisWorkbook.Save
        Application.EnableEvents = True
        ActiveWorkbook.Unprotect Password:="x"
          On Error Resume Next
For Each ws In Sheets
    ws.Visible = True
Next ws
If ThisWorkbook.Sheets.Count > 1 Then Sheets(UdenMakroArk).Visible = xlSheetVeryHidden
        Application.Goto Reference:="MyOrigPlace"
        ActiveWorkbook.Names("MyOrigPlace").Delete
        ActiveWorkbook.Protect Password:="x", Structure:=True, Windows:=True
        Application.ScreenUpdating = True
    End If
    End If
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Application.ActiveWorkbook.Name <> ThisWorkbook.Name Then
Exit Sub
ElseIf Application.ActiveWorkbook.Name = ThisWorkbook.Name Then
With Application
.OnKey "^c" 'Copy shortcut enabled
.OnKey "^v" 'Paste shortcut enabled
.OnKey "^x" 'Cut shortcut enabled
.OnKey "^p" 'Print shortcut enabled
.CellDragAndDrop = True
End With
End If
End Sub

mvh. Lars