Problème d'enregistrement autour de mes fichiers

Bonjour, dans mon entreprise, plusieurs feuilles excel sont partagés en réseau.

Ceux que je met a dispo contiennent des macro.

A priori ce n'est pas un pb de droit puisque "souvent ça marche mais des fois pas".

le problème soulevé est celui la:

image

je vous met le code complet dessous, pensez vous qe l'erreur vienne de ma macro?

Sub alea()

Dim plage As Range
Dim cel As Range
Dim alea As Double
Dim alea2 As Double
Dim i As Integer

'désactivation de l'épilepsie
    Application.ScreenUpdating = False
    Sheets("Liste").Visible = True
    Sheets("Liste").Select

'pour gagner du temps
Application.Calculation = xlManual

'vérif de condition de vidange avant de relancer
Sheets("Liste").Select
If Range("aw2") = 1 Or Range("aw3") = 1 Or Range("aw4") = 1 Then
MsgBox "merci de commencer par dasher tous les audits précédents"
GoTo 4
Else: GoTo 3
End If

3
'Set des value HSE
Set plage = Range("D2:D201")
plage.Value = ""
If plage.Count > 201 Then Exit Sub
Randomize

For Each cel In plage
1 alea = WorksheetFunction.RandBetween(1, 201)
If Application.CountIf(plage, alea) Then GoTo 1 Else cel = alea
Next

i = 1
For i = 2 To 201
If Cells(i, 2) = "" Then
Cells(i, 4) = 0
End If
Next

If Range("F1").Value > Range("E1").Value - 22 Then Range("E2:E201").ClearContents

i = 1
For i = 2 To 10
Cells(i, 10) = Cells(i, 9).Value
Next

i = 1
For i = 2 To 10
k = Cells(i, 10).Value + 1
Cells(k, 5) = "x"
Next

'Set des value 5SPS
Set plage = Range("o2:o201")
plage.Value = ""
If plage.Count > 201 Then Exit Sub
Randomize

For Each cel In plage
2 alea2 = WorksheetFunction.RandBetween(1, 201)
If Application.CountIf(plage, alea2) Then GoTo 2 Else cel = alea2
Next

i = 1
For i = 2 To 201
If Cells(i, 13) = "" Then
Cells(i, 15) = 0
End If
Next

If Range("Q1").Value > Range("P1").Value - 22 Then Range("P2:P201").ClearContents

i = 1
For i = 2 To 7
Cells(i, 21) = Cells(i, 20).Value
Next

i = 1
For i = 2 To 7
k = Cells(i, 21).Value + 1
Cells(k, 16) = "x"
Next

'Set des Dash values
Range("AW2") = 1
Range("AW3") = 1
Range("AW4") = 1

4
'pour gagner du temps/off
Application.Calculation = xlAutomatic

'Retour a la page de lancement
ActiveWindow.SelectedSheets.Visible = False
Sheets("Template_Remplissage").Select
Application.ScreenUpdating = True

End Sub
Dim dlg As Integer
Sub dataimplement_matin()

Dim i As Integer

'Désactivation de l'épilespse
    Application.ScreenUpdating = False
    Sheets("Liste").Visible = True

'vérif de non vide
Sheets("Template_Remplissage").Select
For i = 6 To 11
    If Cells(i, 4) = "" Then
        MsgBox "merci de ne pas laisser de cases vides"
        GoTo 9
    Else:
        If Cells(i, 4) = "Nok" And Cells(i, 5) = "" Then
        MsgBox "une cause et ou une action doit etre renseignée pour chaque Nok"
        GoTo 9
        End If
    End If
Next

For i = 3 To 4
    If Cells(i, 2) = "" Then
        MsgBox "merci de renseigner le responsable d'audit et/ou la date"
        GoTo 9
    Else:
    End If
Next

'ajout dans database des item tests
    Sheets("Liste").Select
    Range("AF2:AT2").Select
    Selection.Copy
    Sheets("Database").Select
    Range("G1").Select
    Selection.End(xlDown)(2).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Transpose:=False

'ajout secteur date auditeur
    Sheets("Template_Remplissage").Select
    Range("$B$3").Select
    Selection.Copy
    Sheets("Database").Select
    Range("E1").Select
    Selection.End(xlDown)(2).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Sheets("Template_Remplissage").Select
    Range("$B$4").Select
    Selection.Copy
    Sheets("Database").Select
    Range("B1").Select
    Selection.End(xlDown)(2).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Range("D1").Select
    Selection.End(xlDown)(2).Select
    ActiveCell.Value = Sheets("Liste").Range("AV2").Value

    dlg = Range("A" & Rows.Count).End(xlUp).Row + 1
    Range("A" & dlg) = dlg - 2

'Remplissage PDCA
                    'ajout dans PDCA des item concernés par un suivi
    Sheets("Template_Remplissage").Select
    Range("A6:E11").Select
    Selection.Copy
    Sheets("PDCA").Select
    Range("A1").Select
    Selection.End(xlDown)(2).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

                    'suppression des lignes
    Range("D1").Select
    Selection.AutoFilter
    ActiveSheet.Range("A:E").AutoFilter Field:=4, Criteria1:="=NA", _
        Operator:=xlOr, Criteria2:="=Ok"
    Rows("2:2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete
    Selection.AutoFilter

'nettoyage commentaire du Template affichage n-1
    Sheets("Liste").Select
    Range("AW2") = 0

    Sheets("Template_Remplissage").Select
    Range("B3:C4,D6:E11").ClearContents

'retour a la feuille et réactivation de l'écran
9
    Sheets("Liste").Select
    ActiveWindow.SelectedSheets.Visible = False
    Sheets("Template_Remplissage").Select
    Application.ScreenUpdating = True '

End Sub
Sub dataimplement_aprem()
Dim i As Integer
i = 16

'Désactivation de l'épilespse
    Application.ScreenUpdating = False
    Sheets("Liste").Visible = True

'vérif de non vide
Sheets("Template_Remplissage").Select
For i = 17 To 22
    If Cells(i, 4) = "" Then
        MsgBox "merci de ne pas laisser de cases vides"
        GoTo 10
    Else:
        If Cells(i, 4) = "Nok" And Cells(i, 5) = "" Then
        MsgBox "une cause et ou une action doit etre renseignée pour chaque Nok"
        GoTo 10
        End If
    End If
Next

For i = 14 To 15
    If Cells(i, 2) = "" Then
        MsgBox "merci de renseigner le responsable d'audit et/ou la date"
        GoTo 10
    Else:
    End If
Next

'ajout dans database des item tests
    Sheets("Liste").Select
    Range("AF3:AT3").Select
    Selection.Copy
    Sheets("Database").Select
    Range("G1").Select
    Selection.End(xlDown)(2).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Transpose:=False

'ajout secteur date auditeur
    Sheets("Template_Remplissage").Select
    Range("$B$14").Select
    Selection.Copy
    Sheets("Database").Select
    Range("E1").Select
    Selection.End(xlDown)(2).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Sheets("Template_Remplissage").Select
    Range("$B$15").Select
    Selection.Copy
    Sheets("Database").Select
    Range("B1").Select
    Selection.End(xlDown)(2).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Range("D1").Select
    Selection.End(xlDown)(2).Select
    ActiveCell.Value = Sheets("Liste").Range("AV3").Value

    dlg = Range("A" & Rows.Count).End(xlUp).Row + 1
    Range("A" & dlg) = dlg - 2

'Remplissage PDCA
                    'ajout dans PDCA des item concernés par un suivi
    Sheets("Template_Remplissage").Select
    Range("A17:E22").Select
    Selection.Copy
    Sheets("PDCA").Select
    Range("A1").Select
    Selection.End(xlDown)(2).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

                    'suppression des lignes
    Range("D1").Select
    Selection.AutoFilter
    ActiveSheet.Range("A:E").AutoFilter Field:=4, Criteria1:="=NA", _
        Operator:=xlOr, Criteria2:="=Ok"
    Rows("2:2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete
    Selection.AutoFilter

'nettoyage commentaire du Template affichage n-1
    Sheets("Liste").Select
    Range("AW3") = 0

    Sheets("Template_Remplissage").Select
    Range("B14:C15,D17:E22").ClearContents

'retour a la feuille et réactivation de l'écran
10
    Sheets("Liste").Select
    ActiveWindow.SelectedSheets.Visible = False
    Sheets("Template_Remplissage").Select
    Application.ScreenUpdating = True '

End Sub
Sub dataimplement_nuit()
Dim i As Integer
i = 16

'Désactivation de l'épilespse
    Application.ScreenUpdating = False
    Sheets("Liste").Visible = True

'vérif de non vide
Sheets("Template_Remplissage").Select
For i = 28 To 33
    If Cells(i, 4) = "" Then
        MsgBox "merci de ne pas laisser de cases vides"
        GoTo 11
    Else:
        If Cells(i, 4) = "Nok" And Cells(i, 5) = "" Then
        MsgBox "une cause et ou une action doit etre renseignée pour chaque Nok"
        GoTo 11
        End If
    End If
Next

For i = 25 To 26
    If Cells(i, 2) = "" Then
        MsgBox "merci de renseigner le responsable d'audit et/ou la date"
        GoTo 11
    Else:
    End If
Next

'ajout dans database des item tests
    Sheets("Liste").Select
    Range("AF4:AT4").Select
    Selection.Copy
    Sheets("Database").Select
    Range("G1").Select
    Selection.End(xlDown)(2).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Transpose:=False

'ajout secteur date auditeur
    Sheets("Template_Remplissage").Select
    Range("$B$25").Select
    Selection.Copy
    Sheets("Database").Select
    Range("E1").Select
    Selection.End(xlDown)(2).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Sheets("Template_Remplissage").Select
    Range("$B$26").Select
    Selection.Copy
    Sheets("Database").Select
    Range("B1").Select
    Selection.End(xlDown)(2).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Range("D1").Select
    Selection.End(xlDown)(2).Select
    ActiveCell.Value = Sheets("Liste").Range("AV4").Value

    dlg = Range("A" & Rows.Count).End(xlUp).Row + 1
    Range("A" & dlg) = dlg - 2

'Remplissage PDCA
                    'ajout dans PDCA des item concernés par un suivi
    Sheets("Template_Remplissage").Select
    Range("A28:E33").Select
    Selection.Copy
    Sheets("PDCA").Select
    Range("A1").Select
    Selection.End(xlDown)(2).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

                    'suppression des lignes
    Range("D1").Select
    Selection.AutoFilter
    ActiveSheet.Range("A:E").AutoFilter Field:=4, Criteria1:="=NA", _
        Operator:=xlOr, Criteria2:="=Ok"
    Rows("2:2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete
    Selection.AutoFilter

'nettoyage commentaire du Template affichage n-1
    Sheets("Liste").Select
    Range("AW4") = 0

    Sheets("Template_Remplissage").Select
    Range("B25:C26,D28:E33").Select
    Selection.ClearContents

'retour a la feuille et réactivation de l'écran

11
    Sheets("Liste").Select
    ActiveWindow.SelectedSheets.Visible = False
    Sheets("Template_Remplissage").Select
    Application.ScreenUpdating = True '

End Sub
Rechercher des sujets similaires à "probleme enregistrement autour mes fichiers"