Recherche + extraction de donnée

  • Initiateur de la discussion Initiateur de la discussion Helldo
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

H

Helldo

Guest
Bonjour à tous,

Cela fait 1h que je suis sur le forum à chercher une solution à mon problème, mais je ne trouve rien de concluant... la dernière fois vous m'avez aidé plus qu'efficacement, j'espère qu'encore une fois vous saurez m'apporter la lumière 🙂

Dans le fichier joint, j'aimerais effectuer une recherche de chaine de caractère dans un tableau et que chaque fois que cette chaine est trouvée (peut importe la colonne), la ligne entière soit recopier sur une autre feuille...
Et pour compliquer le tout, j'aimerais que cette recherche passe outre les maj, min, accents...

Ex: dans l'inputbox on tape "etude" et sur la feuille de résultat il recopie les lignes comprenant les chaînes "étude" "Etude" "Etudes" "Pré-études"...

Merci d'avance
 

Pièces jointes

Re : Recherche + extraction de donnée

Bonjour Helldo,

Voici un code qui répond à ta demande à l'exception des accents (je ne sais pas faire 🙁).



Code:
Option Explicit

Sub Extraire()
Application.ScreenUpdating = False
Dim L, i As Integer
Dim Chaine
Sheets(1).Select

Chaine = Application.InputBox("Mot recherché :")

If Chaine <> False Then
On Error GoTo Erreur
Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = Chaine

Sheets(1).Activate

Sheets(Chaine).Range("A1:F1").Value = Sheets(1).Range("A3:F3").Value
L = Range("A65536").End(xlUp).Row
For i = 4 To L

If Not Rows(i).Find(What:=Chaine) Is Nothing Then
Rows(i).EntireRow.Copy
ActiveSheet.Paste Destination:=Sheets(Chaine).Range("A65536").End(xlUp).Offset(1, 0)

End If

Next
Application.ScreenUpdating = True
Application.CutCopyMode = False
Exit Sub

Erreur:

If Err.Number = 1004 Then
Call MsgBox("Cette extraction existe déjà !", vbExclamation, "Traitement impossible")
Application.DisplayAlerts = False
End If
ActiveSheet.Delete
Application.DisplayAlerts = True

End If
End Sub

@+
 
Re : Recherche + extraction de donnée

Merci Beaucoup Sergio, C exactement la base que je voulais, je vais essayé de le modifier pour que la recherche renvois sur une seule page qui s'initialise à chaque nouvelle recherche ! L'idée de créer une nouvelle feuille ayant le nom de la recherche est balèze, mais ça n'ira pas dans ma configuration...
Pour les accents c'est pas grave, je m'en arrangerai 😎


En tout cas Merci encore !
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.
Retour