Private Sub Workbook_Open()
    Const My_Drive_C_SerialNumber = "12345678" ' сюда пишем серийный номер своего диска
    If Drive_C_SerialNumber <> My_Drive_C_SerialNumber Then
        MsgBox "Вы пытаетесь открыть файл на другом компьютере", vbCritical, "Нет доступа"
        Application.DisplayAlerts = False
        newsh = ThisWorkbook.Worksheets.Add.Name    ' создаём пустой лист
        For Each sh In ThisWorkbook.Worksheets
            If sh.Name <> newsh Then sh.Delete    ' удаляем все листы этого файла, кроме пустого
        Next
        ThisWorkbook.Save
        ThisWorkbook.Close False
    End If
End Sub

Function Drive_C_SerialNumber() As String
    Drive_C_SerialNumber = CreateObject("scripting.filesystemobject").GetDrive("c:\").SerialNumber
End Function