Erreur d'execution 424 : Objet requis Résolu/Fermé

Question

Bonjour à tous, 

j'ai un problème sur Excel, dans la programmation de mon fichier. J'ai cherché un peu partout sur le Net mais je n'ai pas trouvé réponse exacte à mon problème. Je vous explique :

J'ai un fichier qui me donne un listing de projets. Au bout du tableau, j'ai placé deux colonnes qui, lorsqu'on inscrit un "x" dans la case, transfère la ligne sur une autre feuille.
Pourquoi j'ai crée deux colonnes ? Pour transférer certaines lignes sur une feuille et d'autres sur une autre feuille.
Donc, vient mon problème, lorsque je tape "x" dans la première colonne, j'ai le message "erreur d'execution 424 : Objet requis"; alors que dans la deuxième colonne je ne l'ai pas. J'ai cvompris qu'il me manqué une instruction dans la deuxième partie du programme mais je ne vois pas laquelle.

Si quelqu'un avait une idée, ça me serait utile. Merci pour vos réponses. Je joints mon programmeci-dessous.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim DerLigne As String
Dim i As Byte
If Target.Count = 1 Then
    If Left(Target.Address, 3) = "$BD" _
    And LCase(Target.Value) = "x" Then
        With Sheets("Projets terminés")
            i = Target.Offset(1, 0).Row - Target.Row
            DerLigne = .Cells(.Columns(1).Cells.Count, "D").End(xlUp).Row + 1
           ' Cells(Target.Row, 1).Resize(i, 55).Copy Destination:=.Cells(DerLigne, 1)
             Cells(Target.Row, 1).Resize(i, 55).Copy
             
            '.Range("A" & .Columns(1).Cells.Count).End(xlUp) = Now
            .Cells(DerLigne, 56).Value = ActiveSheet.Name
            Feuil3.Activate
            .Cells(DerLigne, 1).Select
            'Feuil3.Paste (Cells(DerLigne, 1))
            
            ActiveSheet.Paste
            'Selection.Paste
            Rows(Target.Row).Resize(i).Delete Shift:=xlUp
        End With
    End If
End If

'Sheets("Suivi des comptes").Cells(1, 1).Activate

If Target.Count = 1 Then
    If Left(Target.Address, 3) = "$BF" _
    And LCase(Target.Value) = "x" Then
        With Sheets("Projets quitussables")
            i = Target.Offset(1, 0).Row - Target.Row
            DerLigne = .Cells(.Columns(1).Cells.Count, "D").End(xlUp).Row + 1
           ' Cells(Target.Row, 1).Resize(i, 55).Copy Destination:=.Cells(DerLigne, 1)
             Cells(Target.Row, 1).Resize(i, 55).Copy
             
            '.Range("A" & .Columns(1).Cells.Count).End(xlUp) = Now
            .Cells(DerLigne, 56).Value = ActiveSheet.Name
            Feuil4.Activate
            .Cells(DerLigne, 1).Select
            'Feuil4.Paste (Cells(DerLigne, 1))
            
            ActiveSheet.Paste
            'Selection.Paste
            Rows(Target.Row).Resize(i).Delete Shift:=xlUp
        End With
    End If
End If

'Sheets("Suivi des comptes").Cells(1, 1).Activate
End Sub


Configuration: Windows XP / Internet Explorer 8.0

f894009 · Accepted Answer

Bonjour, 


Cells(DerLigne, 1).Select 

si la cellule selectionnee est une cellule de la feuil3, il ne faut pas mettre de point devant sinon c'est une cellule de l'onglet "Projets terminés". 


Idem pour la feuil4 

A suivre 

Bonne suite

ThePlisskenism · Answer

Désolé mais ce n'est pas ça. Si j'enlève le point devant Cells, ça ne marche plus.

Je précise autre chose. Lorsque je tape un "x" dans la case, pour l'une ou l'autre colonne, la ligne se transfère quand même. C'est juste que pour la première colonne, une message d'erreur s'affiche mais l'action marche.

Je peux aussi préciser à quelle endroit dans le programme le système se met en débogage. La ligne se surligne en jaune à cet endroit, au deuxième : 

"If Target.Count = 1 Then"

Voilà. D'autres idées ?

f894009 · Answer

Re,

Vous devriez faire un bloc comme ci-dessous, ce serait plus logique, parce qu'il n'y a qu'une seule entree a chaque fois.

    If Left(Target.Address, 3) = "$BD" And LCase(Target.Value) = "x" Then
      ......
    ElseIf Left(Target.Address, 3) = "$BF" And LCase(Target.Value) = "x" Then
      .....
    End If

A suivre

ThePlisskenism · Answer

Désolé, ça ne marche pas non plus, il m'affiche une erreur de compilation maintenant :

"End If sans bloc If"

Je mets mon code au cas où vous repereriez une erreur.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim DerLigne As String
Dim i As Byte
If Target.Count = 1 Then
    If Left(Target.Address, 3) = "$BD" And LCase(Target.Value) = "x" Then _
        With Sheets("Projets terminés")
            i = Target.Offset(1, 0).Row - Target.Row
            DerLigne = .Cells(.Columns(1).Cells.Count, "D").End(xlUp).Row + 1
           ' Cells(Target.Row, 1).Resize(i, 55).Copy Destination:=.Cells(DerLigne, 1)
             Cells(Target.Row, 1).Resize(i, 55).Copy
             
            '.Range("A" & .Columns(1).Cells.Count).End(xlUp) = Now
            .Cells(DerLigne, 56).Value = ActiveSheet.Name
            Feuil3.Activate
            .Cells(DerLigne, 1).Select
            'Feuil3.Paste (Cells(DerLigne, 1))
            
            ActiveSheet.Paste
            'Selection.Paste
            Rows(Target.Row).Resize(i).Delete Shift:=xlUp
        End With
    End If
End If

'Sheets("Suivi des comptes").Cells(1, 1).Activate

If Target.Count = 1 Then
    ElseIf Left(Target.Address, 3) = "$BF" And LCase(Target.Value) = "x" Then
        With Sheets("Projets quitussables")
            i = Target.Offset(1, 0).Row - Target.Row
            DerLigne = .Cells(.Columns(1).Cells.Count, "D").End(xlUp).Row + 1
           ' Cells(Target.Row, 1).Resize(i, 55).Copy Destination:=.Cells(DerLigne, 1)
             Cells(Target.Row, 1).Resize(i, 55).Copy
             
            '.Range("A" & .Columns(1).Cells.Count).End(xlUp) = Now
            .Cells(DerLigne, 56).Value = ActiveSheet.Name
            Feuil4.Activate
            .Cells(DerLigne, 1).Select
            'Feuil4.Paste (Cells(DerLigne, 1))
            
            ActiveSheet.Paste
            'Selection.Paste
            Rows(Target.Row).Resize(i).Delete Shift:=xlUp
        End With
    End If
End If

'Sheets("Suivi des comptes").Cells(1, 1).Activate
End Sub

pijaku · Answer

Bonjour,

"erreur d'execution 424 : Objet requis" : A vérifier :
- les noms des objets WorkSheets (tes feuilles quoi) dans le code par rapport à la réalité. Par moment un espace en fin de nom ne se voit pas sur l'onglet...
==> Sheets("Projets quitussables") 
==> Sheets("Projets terminés") 

- syntaxe "étrange" :
Feuil3.Activate 
Feuil4.Activate 
Feuil3 et Feuil4, j'aurais tendance à remplacer par Sheets("Feuil3").Activate et Sheets("Feuil4").Activate

Sinon, quand tu lances le débogage, qu'elle ligne est surlignée de jaune, ça nous permettrait de ne pas avancer des choses à l'aveuglette.......

ThePlisskenism · Answer

C'est le deuxième If Target.Count = 1 Then

Je vais vérifier ce que tu m'as dis en attendant. Merci.

A suivre.

f894009 · Answer

Re,
ThePlisskenism: Vous avez lu ce que j'ai ecrit et ce que vous avez fait?????

Feuil3.Activate:
Pijaku a a la fois raison et pas raison,parce que la premiere fois que j'ai recupere votre code Feuil3.Activate m'avait parut aussi "etrange", j'ai modifier comme pijaku sheets....et j'ai vu pour une autre personne Feuilx. Activate et ca marche. Mais je pense comme pijaku qu'il est preferable d'ecrire Sheets("Feuilx").Activate.

A suivre

pijaku · Answer

Re-

J'ai repris exactement ton code et adapté deux-trois "bidules" qui me génaient...
exemple :
If Target.Count > 1 Then Exit Sub

Le copier-colelr que tu faisais en 4 lignes est maintenant :
Cells(Target.Row, 1).Resize(i, 55).Copy .Cells(DerLigne, 1)

J'ai viré les Feuil4.Activate...

Remplacé : Left(Target.Address, 3) = "$BD" par : Target.Column = 56
ben oui Left(Target.Address, 3) = "$B$" dans le cas de la colonne BD... pour avoir $B$D c'est Left(Target.Address, 4)
Regarde ce fichier pour voir si ça correspond
Mets des "x" en colonnes BD ou BF...
 
Le code donne :
Private Sub Worksheet_Change(ByVal Target As Range)
Dim DerLigne As String
Dim i As Byte

If Target.Count > 1 Then Exit Sub

If Target.Column = 56 And LCase(Target.Value) = "x" Then
    With Sheets("Projets terminés")
        i = Target.Offset(1, 0).Row - Target.Row
        DerLigne = .Cells(.Columns(1).Cells.Count, "D").End(xlUp).Row + 1
        ' Cells(Target.Row, 1).Resize(i, 55).Copy Destination:=.Cells(DerLigne, 1)
        .Cells(DerLigne, 56).Value = ActiveSheet.Name
        Cells(Target.Row, 1).Resize(i, 55).Copy .Cells(DerLigne, 1)
        '.Range("A" & .Columns(1).Cells.Count).End(xlUp) = Now
        Rows(Target.Row).Resize(i).Delete Shift:=xlUp
    End With
ElseIf Target.Column = 58 And LCase(Target.Value) = "x" Then
    With Sheets("Projets quitussables")
        i = Target.Offset(1, 0).Row - Target.Row
        DerLigne = .Cells(.Columns(1).Cells.Count, "D").End(xlUp).Row + 1
        ' Cells(Target.Row, 1).Resize(i, 55).Copy Destination:=.Cells(DerLigne, 1)
        .Cells(DerLigne, 56).Value = ActiveSheet.Name
        Cells(Target.Row, 1).Resize(i, 55).Copy .Cells(DerLigne, 1)
        '.Range("A" & .Columns(1).Cells.Count).End(xlUp) = Now
        Rows(Target.Row).Resize(i).Delete Shift:=xlUp
        End With
End If
'Sheets("Suivi des comptes").Cells(1, 1).Activate
End Sub--
Cordialement,
Franck P

ThePlisskenism · Answer

Je n'ai pas accès au lien depuis l'ordinateur de mon travail mais j'ai recopié le code pour voir si tout marche ... et tout marche ! 

Merci beaucoup. Et encore désolé, je suis pas très fort en programmation Excel.

Sujet résolu.

Merci encore.

Erreur d'execution 424 : Objet requis

9 réponses

Discussions similaires