voici ton code que j'ai modifié (feuil1 en bdd). Il faut savoir qu'il
fonctionne mais ne me recopie que la 1ère ligne (entête de col) ans info
dessous ?
Private Sub recherche()
Référence = InputBox("Saisisez la Référence", "Référence")
On Error Resume Next
ligne = Sheets("bdd").Range("E3", "E" &
Sheets("bdd").Range("E65535").End(xlUp).Row).Find(What:=Référence, _
After:=Sheets("bdd").Range("E3"), LookIn:=xlValues, LookAt:=xlWhole).Row
If ligne <> "" Then Sheets("bdd").Range("A1").EntireRow.Copy
Sheets.Add.Range("A1")
ActiveSheet.Name = Référence
Sheets("bdd").Range("A" & ligne).EntireRow.Copy
Sheets("référence").Range("A65535").End(xlUp).Offset(1, 0).lignesuivante =
ligne
For i = 1 To Sheets("bdd").Range("E65535").End(xlUp).Row
lignesuivante = Sheets("bdd").Range("E3", "E" &
Sheets("bdd").Range("E65535").End(xlUp).Row).FindNext(After:=Range("E" & _
lignesuivante)).Row
If lignesuivante > ligne Then Sheets("bdd").Range("A" &
ligne).EntireRow.Copy
Sheets("Référence").Range("A65535").End(xlUp).Offset(1, 0).lignesuivante =
ligne
Exit For
i = i + 1
Next
End Sub
Si je relance cette proc il me crèe une autre feuille..... sans les infos,
Ouppsss !
Tu vois le pb ?
En fait c'était bien ce que j'avais compris mais en te proposant ma version 2 je me suis aperçu d'une petite coquille dans ma 1° version peut être à l'origine de l'anomalie
Mille excuses
Ma version1 corrigée donc :
Référence = InputBox("Saisisez la Référence", "Référence") On Error Resume Next Ligne = Sheets("bdd").Range("E1", "E" & Sheets("bdd").Range("E65535").End(xlUp).Row).Find(What:=Référence, After:=Sheets("bdd").Range("E1"), LookIn:=xlValues, _ LookAt:=xlWhole).Row If Ligne <> "" Then Sheets("bdd").Range("A1").EntireRow.Copy Sheets.Add.Range("A1") ActiveSheet.Name = Référence Sheets("bdd").Range("A" & Ligne).EntireRow.Copy Sheets(Référence).Range("A65535").End(xlUp).Offset(1, 0) Lignesuivante = Ligne For i = 1 To Sheets("bdd").Range("E65535").End(xlUp).Row Lignesuivante = Sheets("bdd").Range("E1", "E" & Sheets("bdd").Range("E65535").End(xlUp).Row).FindNext(After:=Range("E" & Lignesuivante)).Row If Lignesuivante > Ligne Then Sheets("bdd").Range("A" & Lignesuivante).EntireRow.Copy Sheets(Référence).Range("A65535").End(xlUp).Offset(1, 0) Else Exit For End If i = i + 1 Next End If
Sur ce lien mon exemple avec tes données et mes ultimes corrections J'ai mis mes 2 versions qui donnent le même résultat ("Traitement" et "Traitement2") Mais la 2° tient compte pour une référence donnée de lignes supplémentaires à la suite qui serait rapporté dans l'onglet Pour celà elle s'appuit sur l'absence colonne E de toute référence sur ces lignes supplémentaires donc raccrochant ces lignes à la 1° référence présente du dessus colonne E
En fait c'était bien ce que j'avais compris mais en te proposant ma version
2 je me suis aperçu d'une petite coquille dans ma 1° version peut être à
l'origine de l'anomalie
Mille excuses
Ma version1 corrigée donc :
Référence = InputBox("Saisisez la Référence", "Référence")
On Error Resume Next
Ligne = Sheets("bdd").Range("E1", "E" &
Sheets("bdd").Range("E65535").End(xlUp).Row).Find(What:=Référence,
After:=Sheets("bdd").Range("E1"), LookIn:=xlValues, _
LookAt:=xlWhole).Row
If Ligne <> "" Then
Sheets("bdd").Range("A1").EntireRow.Copy Sheets.Add.Range("A1")
ActiveSheet.Name = Référence
Sheets("bdd").Range("A" & Ligne).EntireRow.Copy
Sheets(Référence).Range("A65535").End(xlUp).Offset(1, 0)
Lignesuivante = Ligne
For i = 1 To Sheets("bdd").Range("E65535").End(xlUp).Row
Lignesuivante = Sheets("bdd").Range("E1", "E" &
Sheets("bdd").Range("E65535").End(xlUp).Row).FindNext(After:=Range("E" &
Lignesuivante)).Row
If Lignesuivante > Ligne Then
Sheets("bdd").Range("A" & Lignesuivante).EntireRow.Copy
Sheets(Référence).Range("A65535").End(xlUp).Offset(1, 0)
Else
Exit For
End If
i = i + 1
Next
End If
Sur ce lien mon exemple avec tes données et mes ultimes corrections
J'ai mis mes 2 versions qui donnent le même résultat ("Traitement" et
"Traitement2")
Mais la 2° tient compte pour une référence donnée de lignes supplémentaires
à la suite qui serait rapporté dans l'onglet
Pour celà elle s'appuit sur l'absence colonne E de toute référence sur ces
lignes supplémentaires donc raccrochant ces lignes à la 1° référence présente
du dessus colonne E
En fait c'était bien ce que j'avais compris mais en te proposant ma version 2 je me suis aperçu d'une petite coquille dans ma 1° version peut être à l'origine de l'anomalie
Mille excuses
Ma version1 corrigée donc :
Référence = InputBox("Saisisez la Référence", "Référence") On Error Resume Next Ligne = Sheets("bdd").Range("E1", "E" & Sheets("bdd").Range("E65535").End(xlUp).Row).Find(What:=Référence, After:=Sheets("bdd").Range("E1"), LookIn:=xlValues, _ LookAt:=xlWhole).Row If Ligne <> "" Then Sheets("bdd").Range("A1").EntireRow.Copy Sheets.Add.Range("A1") ActiveSheet.Name = Référence Sheets("bdd").Range("A" & Ligne).EntireRow.Copy Sheets(Référence).Range("A65535").End(xlUp).Offset(1, 0) Lignesuivante = Ligne For i = 1 To Sheets("bdd").Range("E65535").End(xlUp).Row Lignesuivante = Sheets("bdd").Range("E1", "E" & Sheets("bdd").Range("E65535").End(xlUp).Row).FindNext(After:=Range("E" & Lignesuivante)).Row If Lignesuivante > Ligne Then Sheets("bdd").Range("A" & Lignesuivante).EntireRow.Copy Sheets(Référence).Range("A65535").End(xlUp).Offset(1, 0) Else Exit For End If i = i + 1 Next End If
Sur ce lien mon exemple avec tes données et mes ultimes corrections J'ai mis mes 2 versions qui donnent le même résultat ("Traitement" et "Traitement2") Mais la 2° tient compte pour une référence donnée de lignes supplémentaires à la suite qui serait rapporté dans l'onglet Pour celà elle s'appuit sur l'absence colonne E de toute référence sur ces lignes supplémentaires donc raccrochant ces lignes à la 1° référence présente du dessus colonne E
