Fonction recherche sur plusieurs onglets

[dav123]

bonjour le forum et meilleurs voeux à tous

je suis à la recherche d'une macro qui me permettrait à partir d'un userform de
rechercher la ou les lignes contenant le mot renseigné dans le userform
et ceux dans chacune des différentes feuilles du classeur

Un fois la ou les lignes trouvées je souhaiterais les copier et les coller dans une autre feuille du classeur appelée "résultat" dès la 1ère ligne vide

Pouvez vous m'aider à développer ce code si toutefois mes explications sont suffisamment claires

 

[job75]

Re : Fonction recherche sur plusieurs onglets

Bonsoir dav123,

Oui c'est clair, mais avec un fichier ce serait mieux.

Voici une macro très générale, en supposant le mot recherché dans la TextBox1 de l'USF :

Private Sub CommandButton1_Click()
If TextBox1 = "" Then TextBox1.SetFocus: Exit Sub
Dim dercel As Range, lig As Long, w As Worksheet, cel As Range
Application.ScreenUpdating = False
Set dercel = Sheets("résultat").Cells.Find("*", LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
If Not dercel Is Nothing Then lig = dercel.Row
For Each w In Worksheets
  If w.Name <> "résultat" Then
    For Each cel In [COLOR="Red"]w.UsedRange[/COLOR]
      If cel = TextBox1 Then 'respecte la casse, sinon => If UCase(cel) = UCase(TextBox1) Then
        lig = lig + 1
        cel.EntireRow.Copy Sheets("résultat").Rows(lig) 'ou ligne ci-dessous si l'on ne veut que les valeurs
        'Sheets("résultat").Rows(lig) = cel.EntireRow.Value
      End If
    Next cel
  End If
Next w
Application.ScreenUpdating = True
End Sub

Elle étudie toutes les cellules dans le UsedRange de chaque feuille ce qui est vraiment bovin.

Un fichier joint permettrait de réduire la zone de recherche...

Edit : il faudra aussi voir ça : si l'on clique 36 fois sur CommandButton1 sans modifier TextBox1, les mêmes lignes seront recopiées 36 fois !

A+

 

[dav123]

Re : Fonction recherche sur plusieurs onglets

Bonjour job75, bonjour le Forum

Merci pour votre réponse
Par contre j'ai du mal a créer le userform avec le texbox alors j'ai joint un fichier pour exemple
Pouvez vous m'aider à finaliser cette macro recherche

 

[job75]

Re : Fonction recherche sur plusieurs onglets

Bonjour dav123,

Il faut bien sûr mettre la macro dans le code de l'UserForm.

J'ai ajouté une checkbox pour la casse et aussi le bouton.

La macro adaptée au fichier :

Private Sub CommandButton1_Click()
Dim lig As Long, w As Worksheet, cel As Range
Application.ScreenUpdating = False
Sheets("résultat").Rows("3:65536").ClearContents
If TextBox1 = "" Then GoTo 1
lig = 2
For Each w In Worksheets
  If w.Name <> "résultat" Then
    For Each cel In w.UsedRange
      If IIf(CheckBox1, cel = TextBox1, UCase(cel) = UCase(TextBox1)) Then
        lig = lig + 1
        Sheets("résultat").Cells(lig, 1) = w.Name
        Sheets("résultat").Cells(lig, 2).Resize(, 20) = w.Cells(cel.Row, 1).Resize(, 20).Value 'copie sur 20 colonnes
      End If
    Next cel
  End If
Next w
1 TextBox1.SetFocus
Application.ScreenUpdating = True
End Sub

De plus l'UserForm s'ouvre en non modal (vbModeless) ce qui permet d'intervenir sur les feuilles bien qu'il soit affiché.

A+

 

[job75]

Re : Fonction recherche sur plusieurs onglets

Re,

Une 2ème version avec une checkbox pour la recherche partielle :

Private Sub CommandButton1_Click()
Dim lig As Long, w As Worksheet, cel As Range, part As String
Application.ScreenUpdating = False
Sheets("résultat").Rows("3:65536").ClearContents
If TextBox1 = "" Then GoTo 1
lig = 2
[COLOR="Red"]part = IIf(CheckBox2, "*", "")[/COLOR]
For Each w In Worksheets
  If w.Name <> "résultat" Then
    For Each cel In w.UsedRange
      If IIf(CheckBox1, cel [COLOR="red"]Like[/COLOR] part & TextBox1 & part, UCase(cel) [COLOR="red"]Like[/COLOR] part & UCase(TextBox1) & part) Then
        lig = lig + 1
        Sheets("résultat").Cells(lig, 1) = w.Name
        Sheets("résultat").Cells(lig, 2).Resize(, 20) = w.Cells(cel.Row, 1).Resize(, 20).Value 'copie sur 20 colonnes
      End If
    Next cel
  End If
Next w
1 TextBox1.SetFocus
Application.ScreenUpdating = True
End Sub

A+

 

[dav123]

Re : Fonction recherche sur plusieurs onglets

Bonjour job75, le forum

Milles merci, c'est parfait et correspond parfaitement à mon besoin
A+

 

[dav123]

Re : Fonction recherche sur plusieurs onglets

Bonjour job75, le forum

je reviens vers vous afin d'optimiser le code
je l'ai intégré à l'application désirée et la recherche est très longue
Sur quelle partie du code faut-il agir pour limiter la recherche à une plage déterminée ?
par ex si je souhaite effectuer la recherche sur chaque feuille de la cellule A1:H300
Pouvez vous m'aider de nouveau

 

[job75]

Re : Fonction recherche sur plusieurs onglets

Bonjour dav123, le forum,

la recherche est très longue
Sur quelle partie du code faut-il agir pour limiter la recherche à une plage déterminée ?

La macro utilise UsedRange et cette plage va jusqu'à la "Dernière cellule" que l'on trouve en faisant menu Edition-Atteindre-Cellules.

On a parfois ainsi des surprises et on "nettoie" alors le fichier en supprimant les lignes ou colonnes inutiles.

Si effectivement il y a beaucoup de cellules à étudier, on peut limiter la recherche et remplacer la ligne :

For Each cel In w.UsedRange

par :

For Each cel In w.[COLOR="Red"][A1:H300][/COLOR]

A+

 

[dav123]

Re : Fonction recherche sur plusieurs onglets

Bonsoir Job 75, le forum

Merci pour ta réponse rapide
c'est nikel

good week