Recherche sur 2 onglets

Bonjour tout le monde

j'utilise une macro qui a l'aide d'un USF me fait une recherche et me copie les résultats sur une autre feuille (Feuil2)

La recherche est ciblée sur une feuille Sh1

J'aurais aimé pouvoir faire une recherche sur Sh1 et Sh2 en même temps et recopier tous les résultats sur la Feuil2 , ceci est il possible ?

Private Sub AfficheListe_Click()

Dim Data As Range, DerL, Lig&, Dest As Range, Premier$, C As Range, Plage As Range

Application.ScreenUpdating = False

'efface les résultats précédents éventuels

Feuil2.Range("b4").CurrentRegion.Offset(1, 0).Clear

If TextBox1 <> "" Then 'si la textbox n'est pas vide

Feuil2.Range("f2").Value = TextBox1 'place le contenu de la textbox dans la cellule F2

DerL = Sh1.CellS(Application.Rows.Count, 1).End(xlUp).Row 'cherche le N° de la dernière ligne

Set Data = Sh1.[A1].CurrentRegion.Offset(1, 0).Resize(DerL - 1) 'attribue le champ de données à la variable Data

For Lig = 1 To Data.Rows.Count 'boucle sur chacune des lignes des données

Set Plage = Data.Rows(Lig) 'attribue la ligne traitée à la variable plage

If Not Plage.Find(TextBox1, , xlValues, xlPart) Is Nothing Then 'si la plage contient la donnée de la textbox

'attribue la première cellule vide en colonne A à la variable Dest

Set Dest = Feuil2.CellS(Application.Rows.Count, 1).End(xlUp).Offset(1, 0)

Data.Rows(Lig).Copy Dest 'Copie et colle

With Dest.Resize(1, Plage.CellS.Count) 'agrandit le champ référencé sous Dest

Set C = .Find(TextBox1, , xlValues, xlPart) 'cherche la ou les cellules contenant la donnée de la textbox

Premier = C.Address 'mémorise l'adresse de la première cellule trouvée

Do

With C.Font: .Bold = 1: .ColorIndex = 3: End With 'met la police en Gras et rouge

Set C = .FindNext(C) 'cherche la suivante éventuelle

Loop While Not C Is Nothing And C.Address <> Premier 'boucle jusqu'à revenir à la première cellule trouvée

End With

End If

Next Lig

End If

Unload Me

Application.ScreenUpdating = True

End Sub

Merci pour votre aide précieuse et bon dimanche à toutes et à tous

Re tout le monde

Je crois avoir réussi en modifiant mon code comme ceci:

Private Sub AfficheListe_Click()
Dim Data As Range, DerL, Lig&, Dest As Range, Premier$, C As Range, Plage As Range
Application.ScreenUpdating = False
'efface les résultats précédents éventuels

Feuil2.Range("b4").CurrentRegion.Offset(1, 0).Clear
If TextBox1 <> "" Then 'si la textbox n'est pas vide
Feuil2.Range("f2").Value = TextBox1 'place le contenu de la textbox dans la cellule F2
DerL = Sh1.CellS(Application.Rows.Count, 1).End(xlUp).Row 'cherche le N° de la dernière ligne
Set Data = Sh1.[A1].CurrentRegion.Offset(1, 0).Resize(DerL - 1) 'attribue le champ de données à la variable Data
For Lig = 1 To Data.Rows.Count 'boucle sur chacune des lignes des données
Set Plage = Data.Rows(Lig) 'attribue la ligne traitée à la variable plage
If Not Plage.Find(TextBox1, , xlValues, xlPart) Is Nothing Then 'si la plage contient la donnée de la textbox
'attribue la première cellule vide en colonne A à la variable Dest
Set Dest = Feuil2.CellS(Application.Rows.Count, 1).End(xlUp).Offset(1, 0)
Data.Rows(Lig).Copy Dest 'Copie et colle
With Dest.Resize(1, Plage.CellS.Count) 'agrandit le champ référencé sous Dest
Set C = .Find(TextBox1, , xlValues, xlPart) 'cherche la ou les cellules contenant la donnée de la textbox
Premier = C.Address 'mémorise l'adresse de la première cellule trouvée
Do
With C.Font: .Bold = 1: .ColorIndex = 3: End With 'met la police en Gras et rouge
Set C = .FindNext(C) 'cherche la suivante éventuelle
Loop While Not C Is Nothing And C.Address <> Premier 'boucle jusqu'à revenir à la première cellule trouvée
End With
End If
Next Lig

[b]Feuil2.Range("f2").Value = TextBox1 'place le contenu de la textbox dans la cellule F2
DerL = Sh2.CellS(Application.Rows.Count, 1).End(xlUp).Row 'cherche le N° de la dernière ligne
Set Data = Sh2.[A1].CurrentRegion.Offset(1, 0).Resize(DerL - 1) 'attribue le champ de données à la variable Data
For Lig = 1 To Data.Rows.Count 'boucle sur chacune des lignes des données
Set Plage = Data.Rows(Lig) 'attribue la ligne traitée à la variable plage
If Not Plage.Find(TextBox1, , xlValues, xlPart) Is Nothing Then 'si la plage contient la donnée de la textbox
'attribue la première cellule vide en colonne A à la variable Dest
Set Dest = Feuil2.CellS(Application.Rows.Count, 1).End(xlUp).Offset(1, 0)
Data.Rows(Lig).Copy Dest 'Copie et colle
With Dest.Resize(1, Plage.CellS.Count) 'agrandit le champ référencé sous Dest
Set C = .Find(TextBox1, , xlValues, xlPart) 'cherche la ou les cellules contenant la donnée de la textbox
Premier = C.Address 'mémorise l'adresse de la première cellule trouvée
Do
With C.Font: .Bold = 1: .ColorIndex = 3: End With 'met la police en Gras et rouge
Set C = .FindNext(C) 'cherche la suivante éventuelle
Loop While Not C Is Nothing And C.Address <> Premier 'boucle jusqu'à revenir à la première cellule trouvée
End With
End If
Next Lig[/b]

End If

Unload Me
Application.ScreenUpdating = True
End Sub

Si quelqu'un a quelque chose de plus simple pourquoi pas

Merci à tous

Rose