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.

1 réponse

f894009
Messages postés
16610
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
6 juillet 2022
1 646
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
0
Kuartz
Messages postés
850
Date d'inscription
vendredi 13 février 2015
Statut
Membre
Dernière intervention
15 février 2019
55
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.
0