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

Résolu
Kuartz Messages postés 852 Date d'inscription   Statut Membre Dernière intervention   -  
Kuartz Messages postés 852 Date d'inscription   Statut Membre Dernière intervention   -
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

  1. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    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
    1. Kuartz Messages postés 852 Date d'inscription   Statut Membre Dernière intervention   65
       
      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