Erreur définie par l'application ou par l'objet

Résolu/Fermé

Kuartz Messages postés 850 Date d'inscription vendredi 13 février 2015 Statut Membre Dernière intervention 15 février 2019 - Modifié par Kuartz le 29/10/2015 à 09:35
Kuartz Messages postés 850 Date d'inscription vendredi 13 février 2015 Statut Membre Dernière intervention 15 février 2019 - 29 oct. 2015 à 10:35

Bonjour,

Voici mon code :

Sub Supprimer_Ligne_Ajouter_Feuille()

Dim NumeroJDA As String, NouvelOnglet As Worksheet
Dim C As Range
Dim D As Range
Dim FeuilleOuColler As Worksheet
Dim Trouve As Range, PlageDeRecherche As Range
Dim Valeur_Cherchee As String, AdresseTrouvee As String
Dim DL as Long
Dim DL2 As Long
Dim DL3 As Long

DL = Sheets("NATIONAL").Cells(Application.Rows.Count, 2).End(xlUp).Row

Ligne = ActiveCell.Row

AdresseJour = ActiveCell.Address

For i = DL To 1 Step -1

If Range("A" & i).Value = "" Then
    If Range("B" & i).Value = "" Then
        If Range("C" & i).Value = "" Then
            Rows(i).Delete
        End If
    End If
End If

Next i

NumeroJDA = InputBox("Numéro JDA?")

If NumeroJDA = "" Then
    Exit Sub
End If
    

IndexFeuil = Sheets("EXPORT").Index

Sheets.Add After:=Sheets(IndexFeuil)

ActiveSheet.Name = "JDA" & NumeroJDA

Sheets("NATIONAL").Activate


For Each C In Sheets("NATIONAL").Range(Cells(Ligne + 1, 1), Cells(DL, 1))
 
    If C.Interior.Color = RGB(128, 0, 128) Then
        Ligne2 = C.Row
        Range(Cells(Ligne + 1, 1), Cells(Ligne2 - 1, 23)).Copy Sheets("JDA" & NumeroJDA).Range("A8")
        Exit For
    End If
    
Next

DL2 = Sheets("JDA" & NumeroJDA).Cells(Application.Rows.Count, 2).End(xlUp).Row

Valeur_Cherchee = Sheets("NATIONAL").Range(AdresseJour)

Set PlageDeRecherche = Sheets("EXPORT").Columns(1)

Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlWhole)

If Trouve Is Nothing Then
    MsgBox ("La date n'a pas été trouvée dans la feuille 'EXPORT'.")
    Exit Sub
Else
    AdresseTrouvee = Trouve.Row
End If

DL3 = Sheets("EXPORT").Cells(Application.Rows.Count, 2).End(xlUp).Row

For Each D In Sheets("EXPORT").Range(Cells(AdresseTrouvee + 1, 1), Cells(DL3, 1))
 
    If D.Interior.Color = RGB(128, 0, 128) Then
        Ligne3 = D.Row
        Range(Cells(AdresseTrouvee + 1, 1), Cells(Ligne3 - 1, 23)).Copy Sheets("JDA" & NumeroJDA).Cells(DL2, 1)
        Exit For
    End If
    
Next


Set PlageDeRecherche = Nothing
Set Trouve = Nothing

End Sub

Le code bloque sur :

For Each D In Sheets("EXPORT").Range(Cells(AdresseTrouvee + 1, 1), Cells(DL3, 1))

Erreur définir par l'application ou par l'objet. Je ne comprend pas.

Merci de votre aide.

A voir également:

Erreur définie par l'application ou par l'objet
Erreur 0x80070643 - Guide
Vente objet occasion entre particulier - Guide
Application gps sans internet - Guide
Comment recuperer whatsapp supprimé par erreur - Guide
Aucune application permettant d'ouvrir ce lien n'a été trouvée - Forum Mobile

1 réponse

Réponse 1 / 1

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
Modifié par f894009 le 29/10/2015 à 10:34

Bonjour,

le probleme vient que l'onglet EXPORT n'est pas actif

Deux solutions:

1/ comme pour "NATIONAL"

Sheets("EXPORT").Activate
DL3 = Sheets("EXPORT").Cells(Application.Rows.Count, 2).End(xlUp).Row
For Each D In Sheets("EXPORT").Range(Cells(AdresseTrouvee + 1, 1), Cells(DL3, 1))
    If D.Interior.Color = RGB(128, 0, 128) Then
        Ligne3 = D.Row
        Range(Cells(AdresseTrouvee + 1, 1), Cells(Ligne3 - 1, 23)).Copy Sheets("JDA" & NumeroJDA).Cells(DL2, 1)
        Exit For
    End If
Next

'ou (solution chere a pijaku)

With Sheets("EXPORT")
    DL3 = .Cells(Application.Rows.Count, 2).End(xlUp).Row
    For Each D In .Range(.Cells(AdresseTrouvee + 1, 1), .Cells(DL3, 1))
        If D.Interior.Color = RGB(128, 0, 128) Then
            Ligne3 = D.Row
            .Range(.Cells(AdresseTrouvee + 1, 1), .Cells(Ligne3 - 1, 23)).Copy Sheets("JDA" & NumeroJDA).Cells(DL2, 1)
            Exit For
        End If
    Next
End With

Kuartz Messages postés 850 Date d'inscription vendredi 13 février 2015 Statut Membre Dernière intervention 15 février 2019 61
29 oct. 2015 à 10:35

Je m'en doutais un peu. Je pensais qu'une boucle de ce type pouvait d'effectuer sans avoir besoin d'activer la feuille en question.

Merci beaucoup pour l'info en tout cas.

Discussions similaires

"Aucune application permettant d'ouvrir cette URL"

Instagram "Désolé, une erreur s'est produite"

Erreur vidéo inconnue sur le Freebox Player

Free erreur 38 : impossible d'envoyer des SMS

Erreur de lecture sur iptv smarters

Discussions similaires

Newsletters