Erreur définie par l'application ou par l'objet [Résolu/Fermé]

Signaler
Messages postés
850
Date d'inscription
vendredi 13 février 2015
Statut
Membre
Dernière intervention
15 février 2019
-
Messages postés
850
Date d'inscription
vendredi 13 février 2015
Statut
Membre
Dernière intervention
15 février 2019
-
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.

1 réponse

Messages postés
15808
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
19 juin 2021
1 502
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
Messages postés
850
Date d'inscription
vendredi 13 février 2015
Statut
Membre
Dernière intervention
15 février 2019
49
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.