Auto naming tabs in a workbook

I'm trying to auto name the 14 tabs of a 2 week workbook with the value of cell B1 which is the date entered on the first worksheet and then auto populated into the other worksheets. The code that I am using does work but on each sheet I have to click on B1 and then the formula bar in order for the tab name to change.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
For Each ws In Worksheets
ActiveSheet.Name = Format(Range("B1").Value, "mmm dd")

Next
End Sub


This is the code that I'm using in "ThisWorkbook", can anyone help with this?

Sorry guys, I tried both of these and can't seem to get them to do anything. I am VB illiterate so the problem may be the keyboard operator.

Thanks Holger, with a little bit of a modification I have it working now.
I entered this code into "ThisWorkbook" and now as soon as I enter the first date, all the tabs rename.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
For Each ws In Worksheets
If Not ws.Range("B1").Value = "" Then ws.Name = Format(ws.Range("B1").Value, "mmm dd")
Next ws
End Sub