Bonjour Fermo et toi le forum,
Bon ben, étant donné que je fais parti du fil et que j'ai reçu ton appel en rapport à mon fichier je vais te donner une réponse...
En fait le principe est simple pour cet exemple, puisqu'au lieu de faire une boucle sur l'ensemble des feuilles présentes dans un fichier on va plutôt...
(et pas Pluto Niark!)
limiter la boucle...
Donc pour cet exemple, j'ai fais une boucle sur deux feuilles...mais tu peux changer tout cela sans problème...il suffit de définir le WS autrement...
Option Explicit
' Vériland décembre 2003
' pour http://www.excel-downloads.com/html/French/forum/messages/1_59111_59111.htm
Private Sub CommandButton2_Click()
Unload Me
End Sub
' si tu veux tu peux aussi faire un tour sur
' ce site : http://perso.wanadoo.fr/veriti/excel/sommaire.htm
' Niark
Private Sub AfficheListe_Click()
Dim WS As Variant
Dim Nom As String
Dim Plage As Range
Dim Cherche, Adresse As String
Dim Ligne, Arrivee As Variant
Dim C As Object
Range("Zone").Clear
Cherche = TextBox1
Ligne = 5
If Cherche = "" Then Exit Sub
Range("F2").Value = Cherche
'donc ici à la place de faire une boucle sur l'ensemble
'des feuilles, on le fait uniquement sur deux feuilles
'à modifier selon le cas...
For WS = 1 To 2
If WS = 1 Then Nom = "Archive livraison"
If WS = 2 Then Nom = "Archive Offre"
Set Plage = Worksheets(Nom).Range("a4:az5000")
With Plage
Set C = .Find(Cherche)
If Not C Is Nothing Then
Adresse = C.Address
Do
Arrivee = Mid(C.Address, 3)
Worksheets(Nom).Range("a" & Arrivee & ":az" & Arrivee).Copy F4.Range("B" & Ligne)
Ligne = F4.Range("" & "B" & "65536").End(xlUp).Row + 1
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address <> Adresse
End If
End With
Next WS
'ici on refait une boucle sur feuille "recherche"
'pour traiter la couleur de la cellule (rouge/gras)
Set Plage = F4.Range("a4:az5000")
With Plage
Set C = .Find(Cherche)
If Not C Is Nothing Then
Adresse = C.Address
Do
Arrivee = Mid(C.Address, 3)
With F4.Range(C.Address)
.Font.Bold = True
.Font.ColorIndex = 3
End With
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address <> Adresse
End If
End With
Unload Me
End Sub
Bon ben j'me suis pas compliqué la vie puisque je te joins tout d'un coup ici, tu n'as plus qu'à faire un copier coller de l'ensemble dans le module Userform de ton fichier et le tour est joué...
Ouarf! j'me suis même échappé de chez moi...hi hi hi
Allez bon courage!
Lien supprimé
PS : Macro à copier depuis le forum auquel cas tu risques d'avoir les attributs gras du post dedans...