XL 2013 Crash de excel au lancement de la macro

Bonjour,

Je rencontre un probleme lorsque je lance ma macro, excel crash 4 fois sur 5.
Voici le code :
Public Sub Enregistrement()

Dim ChDir As String
Dim NomFichier As String
Dim NomCompletFichier As String
Dim Site As String
Dim NomPersonne As String
Dim Matricule As String
Dim x As String
Dim wk As String
Dim ws As Worksheet


wk = ActiveWorkbook.Name

Workbooks.Open Filename:="O:\Nambour\NProduction\Blow Moulding Daily Report\Monthly_Report.xlsm"
'ChDir = "O:\Nambour\NProduction\Blow Moulding Daily Report"
'Site = "BlowMoulding_Production_Report"
NomPersonne = Format(Date, "DDMMMYY")
'x = Format(Time, "hh-mm")
'Matricule = NomPersonne & " " & x
Windows(wk).Activate
Worksheets("Global").Select
Worksheets("Global").Copy Before:=Workbooks("Monthly_Report.xlsm").Sheets("Sheet1")
Worksheets("Global").Name = NomPersonne
Range("A1:Z30") = Range("A1:Z30").Value


For Each ws In Worksheets
ws.Range("A4").Value = ws.Name
Next ws

Workbooks("Monthly_Report.xlsm").Save
Workbooks("Monthly_Report.xlsm").Close
Workbooks.Open Filename:="O:\Nambour\NProduction\Blow Moulding Daily Report\BlowMoulding_Production_Report.xlsm"
For Each wb In Workbooks
If Not wb Is Workbooks("BlowMoulding_Production_Report.xlsm") Then
wb.Close False
End If
Next

End Sub

Si quelqu'un a une idee du pourquoi du comment ... Help !!!