bonjour,
je rouvre ce topic car la meme erreur est arrivé sur un autre fichier:
avec le code qui plante :
Sub dataimplement_aprem()
Dim i As Integer
i = 16
'Désactivation de l'épilespse
Application.ScreenUpdating = False
Sheets("Liste").Visible = True'<====================ça plante ici alors que la sheet "Liste" existe bien
'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
merci d'avance pour votre aide