Une erreur 1004 en partage seulement

Bonjour,

Bonjour,

j'ai une macro qui fonctionnait parfaitement jusqu'à maintenant.
Un point important est que le bug n'arrive que lorsque le fichier est en partage.

en mode partage la macro s'exécute mais plante et n'ajoute pas de données en E et C.

Problème, impossible d'ouvrir l'éditeur en mode partage. et plus de défaut en mode classique .....

Quelqu'un saurait-il m'aider sur ce problème?
Merci

Ci-dessous la macro.

Option Explicit

Private Sub BtnAjouter()
    Const pieces_par_moulée As Long = 4
    Dim lig As Long, derlig As Long, nouvlig As Long, dernouvlig As Long, cellule As Range
        
    If Len(NumProd) <> 5 Or Not IsNumeric(NumProd) Then MsgBox ("Entrer 5 chiffres SVP"): NumProd = ""
    If NumProd = "" Then: Exit Sub
    If NbProd Mod 4 <> 0 Then MsgBox ("Entrer un nombre de pièces multiple de 4"): NbProd = ""
    If NbProd = "" Then: Exit Sub
    If IsNumeric(NumProd) And IsNumeric(NbProd) Then
        
        Application.ScreenUpdating = False
        ActiveSheet.AutoFilterMode = False
        
        ''derlig = Cells.SpecialCells(xlCellTypeLastCell).Select
        derlig = Range("E7").End(xlDown).Row 'détermination de la dernière ligne de l'ancienne prod
        nouvlig = derlig + 1 'détermination de la première ligne de la nouvelle prod
        If Cells(nouvlig, "B") <> "" Then MsgBox ("Erreur dans l'ajout d'une nouvelle production!")  'si nouvelle ligne n'est pas vide erreur (car pas de num traca sur la prod précédente)
        dernouvlig = derlig + NbProd
        Range(Cells(nouvlig - 4, "D"), Cells(derlig, "D")).Copy 'copie des empreintes
        Range(Cells(nouvlig, "D"), Cells(dernouvlig, "D")).Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
        Cells(nouvlig, "B").Value = NumProd 'ajout du num de prod
        Cells(nouvlig, "B").Copy
        Range(Cells(nouvlig, "B"), Cells(dernouvlig, "B")).Select 'copie du num de prod sur la nouvelle prod
        ActiveSheet.Paste
        Cells(nouvlig, "J").Value = "En attente de passage RX" 'ajout d'une note en attente du passage RX
        Cells(nouvlig, "J").Copy
        Range(Cells(nouvlig, "J"), Cells(dernouvlig, "J")).Select 'copie de "attente passage RX" sur la nouvelle prod
        ActiveSheet.Paste
        Selection.FormatConditions.Add Type:=xlTextString, String:="En attente de passage RX", _
            TextOperator:=xlContains 'ajout de la chaine de caractère pour condition
        Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
        With Selection.FormatConditions(1).Interior
            .Color = RGB(255, 120, 20) 'colorisation orage vif
        End With
        Selection.FormatConditions(1).StopIfTrue = False    ' fin si cellule vide
        Selection.Value = Selection.Value 'pour supprimer l'erreur "nombre stocké sous forme de texte"
        Application.CutCopyMode = False
        Cells(nouvlig, "C").Value = 1 'inscription des moulée
            If NbProd > 4 Then 'pour éviter bug de boucle si prod à 1 moulée
            Range(Cells(nouvlig, "C"), Cells(nouvlig + 3, "C")).Select
            Selection.AutoFill Destination:=Range(Cells(nouvlig, "C"), Cells(dernouvlig, "C")), Type:=xlFillDefault
            End If
        Range(Cells(derlig - 1, "E"), Cells(derlig, "E")).Select 'ajout du numéro des pièces
        Selection.AutoFill Destination:=Range(Cells(derlig - 1, "E"), Cells(dernouvlig, "E")), Type:=xlFillDefault
        Range(Cells(nouvlig, "A"), Cells(dernouvlig, "CA")).Select 'ajout des bordures sur la nouvelle prod
        Selection.Borders.Weight = xlThin
        Cells(dernouvlig, "E").Select
        Application.ScreenUpdating = True
        MsgBox ("Nouvelle production ajoutée")
        Me.Hide
    End If
End Sub

Private Sub AJOUTER_Click()
BtnAjouter
End Sub