Sheet becomes a hyperlink when protected

[aussiegirlone]

Can someone help with modifying this code as there is a problem with it?
It does do what it is supposed to do but the problem is when I protect the
sheets that the active cell B1 hyperlinks the whole sheet of every sheet that
has @ in it. How can I deactivate B1 and activate A1 or C1 to enable
protection


Option Explicit

Sub Mail_Every_Worksheet()
'Working in 2000-2007
Dim sh As Worksheet
Dim wb As Workbook
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object

TempFilePath = Environ$("temp") & "\"

If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007
FileExtStr = ".xlsm": FileFormatNum = 52
End If

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon

For Each sh In ThisWorkbook.Worksheets
If sh.Range("B1").Value Like "?*@?*.?*" Then

sh.Copy
Set wb = ActiveWorkbook

TempFileName = "Sheet " & sh.Name & " of " _
& ThisWorkbook.Name & " " & Format(Now, "dd-mmm-yy
h-mm-ss")

Set OutMail = OutApp.CreateItem(0)

With wb
.SaveAs TempFilePath & TempFileName & FileExtStr,
FileFormat:=FileFormatNum

On Error Resume Next
With OutMail
.To = sh.Range("B1").Value
.CC = ""
.BCC = ""
.Subject = "Your Roster for the Week"
.Body = "Please Confirm if this is correct"
.Attachments.Add wb.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Display 'or use .Send
End With
On Error GoTo 0

.Close savechanges:=False
End With
Set OutMail = Nothing

Kill TempFilePath & TempFileName & FileExtStr

End If
Next sh

Set OutApp = Nothing

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub