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 -
Kuartz Messages postés 852 Date d'inscription Statut Membre Dernière intervention -
Bonjour,
Voici mon code :
Le code bloque sur :
Erreur définir par l'application ou par l'objet. Je ne comprend pas.
Merci de votre aide.
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
- Nommez une application d'appel vidéo ou de visioconférence - Guide
- Desinstaller application windows - Guide
- Son notification par application android - Guide
- Comment recuperer whatsapp supprimé par erreur - Guide
- Windows application démarrage - Guide
1 réponse
Bonjour,
le probleme vient que l'onglet EXPORT n'est pas actif
Deux solutions:
1/ comme pour "NATIONAL"
'ou (solution chere a pijaku)
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
Merci beaucoup pour l'info en tout cas.