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.