Validation en VBA : erreur à l'ouverture du fichier

Bonjour,

J'ai un soucis lorsque je rajoute des validations par l'intermédiaire d'un script VBA : cela fonctionne parfaitement jusqu'à la fermeture du fichier mais à la réouverture le message suivant apparaît : "Désolé... Nous avons trouvé un problème dans le contenu de "stage.xlsm", mais nous pouvons essayer de récupérer un maximum de contenu. Si la source du classeur est fiable cliquer sur oui"

Une fois que je clique sur oui, je n'ai plus que les données brutes du fichier et perds toute la mise en forme (couleur, police, mise en forme conditionnelles, largeur et hauteur des cellules, boutons de déclenchement des macros...)

Je précise que tout fonctionne très bien lors d'une validation mise en place à la main ou lorsque j'enlève toutes les validations introduites par le script VBA.

Savez-vous comment corriger cela?

Merci d'avance pour vos retours,

zigzag12

Sub MAJliens()
'Déremination du nombre de ligne de barème
nb_lignes_bareme = 2
While ThisWorkbook.Sheets("Barème").Cells(nb_lignes_bareme, 1).MergeArea.Rows.Count > 1
    Fusbar = ThisWorkbook.Sheets("Barème").Cells(nb_lignes_bareme, 1).MergeArea.Rows.Count
        nb_lignes_bareme = nb_lignes_bareme + Fusbar
Wend
nb_lignes_bareme = nb_lignes_bareme - Fusbar

'Nombre de lignes de liste stages
nb_lignes_stage = 1
While ThisWorkbook.Sheets("Stages").Cells(nb_lignes_stage, 1) <> ""
    nb_lignes_stage = nb_lignes_stage + 1
Wend
nb_lignes_stage = nb_lignes_stage - 1

'Mise en place des validation
'Liste des entrepirses
Dim entre() As String
nb_ent = 1
j = 2
While ThisWorkbook.Sheets("Barème").Cells(j, 1).MergeArea.Rows.Count > 1
    ReDim Preserve entre(nb_ent) As String
    entre(nb_ent) = ThisWorkbook.Sheets("Barème").Cells(j, 1)
    Fus = ThisWorkbook.Sheets("Barème").Cells(j, 1).MergeArea.Rows.Count
    j = j + Fus
    nb_ent = nb_ent + 1
Wend
tri entre, 1, nb_ent - 1
entre2 = ""
For i = 1 To nb_ent - 1
    entre2 = entre2 & entre(i) & ","
Next i

'liste des sites
Dim site() As String
nb_site = 1
j = 2
While ThisWorkbook.Sheets("Barème").Cells(j, 2).MergeArea.Rows.Count > 1
    ReDim Preserve site(nb_site) As String
    site(nb_site) = ThisWorkbook.Sheets("Barème").Cells(j, 2)
    Fus = ThisWorkbook.Sheets("Barème").Cells(j, 1).MergeArea.Rows.Count
    j = j + Fus
    nb_site = nb_site + 1
Wend
tri site, 1, nb_site - 1
site2 = ""
For i = 1 To nb_site - 1
    site2 = site2 & site(i) & ","
Next i

'Validation sur les entreprise
For i = 2 To nb_lignes_stage + 5
    With ThisWorkbook.Sheets("Stages").Cells(i, 2).Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=entre2
        .IgnoreBlank = True
        .InCellDropdown = True
        .ErrorTitle = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With

    If ThisWorkbook.Sheets("Stages").Cells(i, 2) = "" Then
        With ThisWorkbook.Sheets("Stages").Cells(i, 3).Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=site2
        .IgnoreBlank = True
        .InCellDropdown = True
        .ErrorTitle = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
        End With
    'Cas où l'entreprise est déjà sélectionnée
    Else
        For j = 1 To nb_lignes_bareme
            If ThisWorkbook.Sheets("Stages").Cells(i, 2) = ThisWorkbook.Sheets("Barème").Cells(j, 1) Then
                Fus = ThisWorkbook.Sheets("Barème").Cells(j, 1).MergeArea.Rows.Count
                Dim a As String
                a = ""
                For k = 0 To Fus - 1
                    If ThisWorkbook.Sheets("Barème").Cells(j + k, 2) <> "" Then
                    a = a & ThisWorkbook.Sheets("Barème").Cells(j + k, 2) & ","
                    End If
                Next k
                With ThisWorkbook.Sheets("Stages").Cells(i, 3).Validation
                    .Delete
                    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                    xlBetween, Formula1:=a
                    .IgnoreBlank = True
                    .InCellDropdown = True
                    .ErrorTitle = ""
                    .ErrorMessage = ""
                    .ShowInput = True
                    .ShowError = True
                End With
                Exit For
            End If
        Next j
    End If
Next i
End Sub