Erreur automation 80028029

Bonjour,

je viens vers vous avec une nouvelle question,

j'ai eu cette erreur (remonté par un opérateur):

j'ai solutionne le problème en faisant une copie de la worksheets concernée (qui ne posait aucun pb jusque la)

et en envoyant ma macro vers cette copie et en supprimant l'original

j'ai vu un message de Pere-Seval qui parlait exactement de cette erreur mais je n'ai pas compris la solution

le code

Sub PDCA_Concat_Dash()

'Désactivation de l'épilespse
    Application.ScreenUpdating = False

'ajout dans PDCA des item concernés par un suivi
    Sheets("Template-affichage").Select
    Range("M9:P33").Select
    Selection.Copy
    Sheets("PDCA").Select=======================================================>>>>>ça plantait ici
    Range("A1").Select
    Selection.End(xlDown)(2).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

'suppression des lignes
    Range("A1").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$B$25").AutoFilter Field:=1, Criteria1:="-"
    Rows("2:2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select

    Selection.Delete
    Selection.AutoFilter
    Range("O4").Select

'retour a la feuille et réactivation de l'écran
    Sheets("Template-affichage").Select
    Application.ScreenUpdating = True '
'
End Sub

Bonjour

Cordialement

Bonjour

Je n'ai pas d'erreur mentionnée d'où j'imagine que cela peut venir de votre opérateur. Essayez votre code comme ceci :

Sub PDCA_Concat_Dash()

'Désactivation de l'épilespse
Application.ScreenUpdating = False

'ajout dans PDCA des item concernés par un suivi
Sheets("Template-affichage").Range("M9:P33").Copy

With Sheets("PDCA")
    dlg = .Range("A" & .Rows.Count).End(xlUp).Row + 1
    .Range("A" & dlg).PasteSpecial Paste:=xlPasteValues

    'suppression des lignes
    If .AutoFilterMode = False Then .Range("A1").AutoFilter
        .Range("A:A").AutoFilter Field:=1, Criteria1:="-"
        .Range(.Rows("2:2"), .Rows("2:2").End(xlDown)).Delete
        .AutoFilterMode = False
End With
Application.ScreenUpdating = True
End Sub

Crdlt

merci pour cette proposition, dlg c'est une variable?

car je ne vois rien de mentionné en déclaration?

si je comprend l'esprit du truc c'est de stocker une valeur "la première ligne libre est...'' en partant d'en pas de la feuille la ou avant je disais "la première ligne libre est... '' en partant d'en haut''

c'est ça?

de même il ne manque pas un "end if" dans le paragraphe "suppression de ligne"?

merci pour cette proposition, dlg c'est une variable?

Oui désolé. J'ai omis de l'ajouter d'où elle était par défaut en VARIANT. Mettez ceci en début de code --> DIM dlg as INTEGER

si je comprend l'esprit du truc c'est de stocker une valeur "la première ligne libre est...'' en partant d'en pas de la feuille la ou avant je disais "la première ligne libre est... '' en partant d'en haut''

Oui exact. C'est toujours mieux de partir du bas car si vous partez du haut et que par hasard vous avez une cellule vide au milieu dans la colonne A, ...patatra le code va coller vos données à partir de cette ligne vide.

Crdlt

merci pour vos réponses

et pour le end if manquant?

re

et pour le end if manquant?

Il n'y a pas de END IF manquant vu que l'instruction est placée juste derrière le THEN

Crdlt

ah on peut faire ça?

ok

Oui bien sûr.

C'est plus facile à lire (1 seule ligne) lorsqu'il n'y a qu'une seule action en fonction de ce que le IF renvoie comme info.

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

Bonjour

Si vous désactivez la ligne incriminée, il se passe quoi ?

Essayez en plaçant Application.screen après la ligne qui pose question

Mieux mettez votre fichier en ligne

Bonjour

Cordialement