Besoin aide pour préciser le code

[jsv]

Bonjour le forum,
cela fait quelques jours que je galère avec mon code. je ne suis pas expert loin de là, du coup j'ai récupéré des conseils à droite à gauche pour arriver pas loin du résultat!
En gros, c'est un mini moteur de recherche par mots clés sur plusieurs onglets d'un même fichier excel.
Lorsque je lance la recherche, il me retrouve bien toutes les lignes sur les différents onglets où le mot clé utilisé se trouve, mais dans ces lignes il y a des liens hypertextes qui sautent. C'est comme s'il ne faisait que recopier ce qu'il y a dans les cellules de la ligne sans tenir compte de la casse, couleur, lien hypertexte d'origine...
J'avoue être dépassé! si qqun pouvait m'aider, voici le code en question

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

 

[Guest]

Re : Besoin aide pour préciser le code

bonjour,

.Value demande de ne copier que la valeur.

Ce serait plutôt:

w.Cells(cel.Row, 1).Resize(, 20).Copy Destination:=Sheets("Moteur de Recherche").Cells(lig, 2)

A+

 

[jsv]

Re : Besoin aide pour préciser le code

Bonjour Hasco et merci pour ta réponse rapide!
je vais tester de ce pas!!

A+

 

[jsv]

Re : Besoin aide pour préciser le code

Re bonjour,
malheureusement cela ne marche pas... cela se colore en rouge avec erreur de compilation : erreur de syntaxe...

Sheets("Moteur de Recherche").Cells(lig, 2) = w.Cells(cel.Row, 1).Resize(, 20).Value.Copy Destination:=Sheets("Moteur de Recherche").Cells(lig, 2)

à moins que ca ne soit pas là quil faille le mettre?

 

[Guest]

Re : Besoin aide pour préciser le code

Re,

Ben on va esssayer de ne pas tâtonner: Joint un fichier exemple épuré et <50ko.

Mais c'est pas ça que je t'ai donné.

Re:

 w.Cells(cel.Row, 1).Resize(, 20).Copy Destination:=Sheets("Moteur de Recherche").Cells(lig, 2)

A+

 

[jsv]

Re : Besoin aide pour préciser le code

ok merci je trouve comment joindre un fichier et je te mets une copié épurée.

 

[jsv]

Re : Besoin aide pour préciser le code

Bon j'sais pas si c'est comme çà qu'il faut faire mais je t'ai mis un lien sur cjoint de mon fichier.

http://cjoint.com/?0cqmYh8YZGE

A+

 

[Guest]

Re : Besoin aide pour préciser le code

Re,

Zip ton fichier et joint le ici, je ne vais chercher les fichiers ailleurs que très exeptionnellement.
Va dans l'éditeur de post avancé (En cliquant sur le bouton 'Aller en mode avancé') puis sous l'éditeur de post tu auras un autre bouton: 'Gérer les pièces jointes'. clique et laisse toi guider.

Ne pas oublier de valider le choix du fichier en cliquant sur le bouton 'envoyer' avant de fermer la fenêtre.

A+

 

[jsv]

Re : Besoin aide pour préciser le code

Ok merci pour tes précisions, voici une version de mon fichier!

 

[Guest]

Re : Besoin aide pour préciser le code

Bonjour,

Il y a des fois où l'on se demande si les questioneurs lisent bien les réponses qui leur sont faites!

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

A+

 

[jsv]

Re : Besoin aide pour préciser le code

Bon, ben merci et dsl!
c'est juste que je ne mettais pas le bout de code au bon endroit! ( plus précisément je n'effaçais pas suffisamment de données avant).

A+

 

[Guest]

Re : Besoin aide pour préciser le code

Re,

Pas de problème.
si ce n'est le style sms ou télégraphique du 'dsl' non recommandé par la charte du forum.

A+