Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Besoin d'aide pour un "recherche-coller"

Créer une discussion

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 !

S'inscrire
R

rainbow69006

XLDnaute Occasionnel
Bonjour

Je souhaiterais creer un genre de fonction recherche, qui recherche dans mes pages un mot speifie et me copie une partie de la colonne dans une feuille de resultat.

Comme un exemple vaut mieu qu'un long discours je vous joint un fichier avec plus d'expliquations

Merci🙂
 

Pièces jointes

Trier par date Trier par votes
Re : Besoin d'aide pour un "recherche-coller"

Bonjour skoobi

Juste encore un petit probleme. Mon programe parfaitement mais j'ai un probleme lorsque je n'ai pas de photo1, pas de photo2, pas de photo3 mais que j'ai une photo4 sa m'affiche ce probleme:
The index into the specified collection is out of bounds

voila mon code
Code: 
Private Sub ComboBox2_Change()
Range("E10:E22").ClearContents
Range("I10:I22").ClearContents
Range("M10:M22").ClearContents
Col = 1
For f = 1 To 4
    With Sheets(f)
        Set marque = Sheets(f).Cells.Find(ComboBox1.Value, LookIn:=xlValues)
        Set modele = Sheets(f).Cells.Find(ComboBox2.Value, LookIn:=xlValues)
        If Not marque Is Nothing And Not modele Is Nothing Then
            If marque.Address = modele.Address Then .Range(marque, marque.Offset(12, 0)).Copy Sheets("page per models").Cells(10, Col)
        End If
        Col = Col + 4
    End With
Next


For Each Sh In ActiveSheet.Shapes
    If Sh.Name Like "Picture*" Then Sh.delete
Next


With Application.FileSearch
    .LookIn = "W:\" & ComboBox1.Value & "\" & ComboBox1.Value & " " & ComboBox2.Value & "\photo1"
    .Filename = "*"
    .Execute
    If .FoundFiles.Count > 0 Then
        Range("B25").Select
'ceci devrait permettre de prendre que la 1ere photo du dossier, à voir:
        ActiveSheet.Pictures.Insert (.FoundFiles(1))
        ActiveSheet.Shapes(num_dos + 3).Height = 150
        
    End If
End With

With Application.FileSearch
    .LookIn = "W:\" & ComboBox1.Value & "\" & ComboBox1.Value & " " & ComboBox2.Value & "\photo2"
    .Filename = "*"
    .Execute
    If .FoundFiles.Count > 0 Then
        Range("H25").Select
'ceci devrait permettre de prendre que la 1ere photo du dossier, à voir:
        ActiveSheet.Pictures.Insert (.FoundFiles(1))
        ActiveSheet.Shapes(num_dos + 4).Height = 150
    End If
End With

With Application.FileSearch
.LookIn = "W:\" & ComboBox1.Value & "\" & ComboBox1.Value & " " & ComboBox2.Value & "\photo3"
    .Filename = "*"
    .Execute
    If .FoundFiles.Count > 0 Then
        Range("B41").Select
'ceci devrait permettre de prendre que la 1ere photo du dossier, à voir:
        ActiveSheet.Pictures.Insert (.FoundFiles(1))
         ActiveSheet.Shapes(num_dos + 5).Height = 150
    End If
End With

With Application.FileSearch
    .LookIn = "W:\" & ComboBox1.Value & "\" & ComboBox1.Value & " " & ComboBox2.Value & "\photo4"
    .Filename = "*"
    .Execute
    If .FoundFiles.Count > 0 Then
        Range("H41").Select
'ceci devrait permettre de prendre que la 1ere photo du dossier, à voir:
        ActiveSheet.Pictures.Insert (.FoundFiles(1))
         ActiveSheet.Shapes(num_dos + 6).Height = 150
    End If
End With

End Sub
 
Vote positif 0 Vote négatif
Re : Besoin d'aide pour un "recherche-coller"

Re,

Donc la derniere est la shapes 6.
Cliquez pour agrandir...
Pas si les dossiers photo1 à photo3 sont vides.
Il faut intégrer une variable qui s'incrémente quand une photo est trouvée dans un dossier:

Code: 
Private Sub ComboBox2_Change()
Range("E10:E22").ClearContents
Range("I10:I22").ClearContents
Range("M10:M22").ClearContents
Col = 1
For f = 1 To 4
    With Sheets(f)
        Set marque = Sheets(f).Cells.Find(ComboBox1.Value, LookIn:=xlValues)
        Set modele = Sheets(f).Cells.Find(ComboBox2.Value, LookIn:=xlValues)
        If Not marque Is Nothing And Not modele Is Nothing Then
            If marque.Address = modele.Address Then .Range(marque, marque.Offset(12, 0)).Copy Sheets("page per models").Cells(10, Col)
        End If
        Col = Col + 4
    End With
Next


For Each Sh In ActiveSheet.Shapes
    If Sh.Name Like "Picture*" Then Sh.Delete
Next

[COLOR=Blue][B]nb_photo = 0[/B][/COLOR]
With Application.FileSearch
    .LookIn = "W:\" & ComboBox1.Value & "\" & ComboBox1.Value & " " & ComboBox2.Value & "\photo1"
    .Filename = "*"
    .Execute
    If .FoundFiles.Count > 0 Then
        [COLOR=Blue][B]nb_photo = nb_photo + 1[/B][/COLOR]
        Range("B25").Select
        'ceci devrait permettre de prendre que la 1ere photo du dossier, à voir:
        ActiveSheet.Pictures.Insert (.FoundFiles(1))
        ActiveSheet.Shapes([COLOR=Blue][B]nb_photo + 2[/B][/COLOR]).Height = 150
    End If
End With

With Application.FileSearch
    .LookIn = "W:\" & ComboBox1.Value & "\" & ComboBox1.Value & " " & ComboBox2.Value & "\photo2"
    .Filename = "*"
    .Execute
    If .FoundFiles.Count > 0 Then
        [COLOR=Blue][B]nb_photo = nb_photo + 1[/B][/COLOR]
        Range("H25").Select
        'ceci devrait permettre de prendre que la 1ere photo du dossier, à voir:
        ActiveSheet.Pictures.Insert (.FoundFiles(1))
        ActiveSheet.Shapes([COLOR=Blue][B]nb_photo + 2[/B][/COLOR]).Height = 150
    End If
End With

With Application.FileSearch
    .LookIn = "W:\" & ComboBox1.Value & "\" & ComboBox1.Value & " " & ComboBox2.Value & "\photo3"
    .Filename = "*"
    .Execute
    If .FoundFiles.Count > 0 Then
        [COLOR=Blue][B]nb_photo = nb_photo + 1[/B][/COLOR]
        Range("B41").Select
        'ceci devrait permettre de prendre que la 1ere photo du dossier, à voir:
        ActiveSheet.Pictures.Insert (.FoundFiles(1))
        ActiveSheet.Shapes([COLOR=Blue][B]nb_photo + 2[/B][/COLOR]).Height = 150
    End If
End With

With Application.FileSearch
    .LookIn = "W:\" & ComboBox1.Value & "\" & ComboBox1.Value & " " & ComboBox2.Value & "\photo4"
    .Filename = "*"
    .Execute
    If .FoundFiles.Count > 0 Then
        [B][COLOR=Blue]nb_photo = nb_photo + 1[/COLOR][/B]
        Range("H41").Select
        'ceci devrait permettre de prendre que la 1ere photo du dossier, à voir:
        ActiveSheet.Pictures.Insert (.FoundFiles(1))
        ActiveSheet.Shapes([COLOR=Blue][B]nb_photo + 2[/B][/COLOR]).Height = 150
    End If
End With

End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Besoin d'aide pour un "recherche-coller"

Ca marche impeccablement maintenant super.

Je voudrais faire une amelioration:
En faite pour le moment cela recherche le modele et la marque et sa copies les 12 cellules qui sont en desous du nom du modele.
Je voudrais qu'en plus cela me copie les cellules qui sont dans la colonne BC

J'ai fais ce code mais il y a une erreur. Je pense qu'il ne faut pas mettre BC mais quoi d'autres alors?

HTML: 
Private Sub ComboBox2_Change()
Range("E10:E22").ClearContents
Range("I10:I22").ClearContents
Range("M10:M22").ClearContents
Col = 1
For f = 1 To 4
    With Sheets(f)
        Set marque = Sheets(f).Cells.Find(ComboBox1.Value, LookIn:=xlValues)
        Set modele = Sheets(f).Cells.Find(ComboBox2.Value, LookIn:=xlValues)
        If Not marque Is Nothing And Not modele Is Nothing Then
            If marque.Address = modele.Address Then .Range(marque, marque.Offset(12, 0)).Copy Sheets("page per models").Cells(10, Col)
          [COLOR="Red"]If marque.Address = modele.Address Then .Range(marque, BC.Offset(10, 0)).Copy Sheets("page per models").Cells(10, 16)[/COLOR]
        End If
        Col = Col + 4
    End With
Next

Merci de ton aide precieuse
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Besoin d'aide pour un "recherche-coller"

Ih Ih Ih excuse moi je te prend tojour pour un surhomme

Je ne peu plus envoyer le dernier fichier avec le code etc.. il fais 4MO maintenant.

Je te renvoi donc une ancienne version complete avec ce que je voudrais

Merci
 

Pièces jointes

Vote positif 0 Vote négatif
Re : Besoin d'aide pour un "recherche-coller"

Bonjour,

A tester:

Code: 
Private Sub ComboBox2_Change()
With Sheets("ce que je veu")
   .Range("B4:E14").ClearContents
   .Range("B16:E26").ClearContents
   .Range("B28:E28").ClearContents
End With
ligne = -8
For f = 1 To 4
    ligne = ligne + 12
    With Sheets(f)
        Set marque_modele = .Cells.Find(Trim(ComboBox1.Value) & " " & ComboBox2.Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not marque_modele Is Nothing Then
            .Range(.Range("BA" & marque_modele.Row), .Range("BD" & marque_modele.Row + 10)).Copy Sheets("ce que je veu").Cells(ligne, 2)
        End If
    End With
Next
End Sub
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- 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

Discussions similaires

M
  • Résolu(e)
Autres Faire une recherche de sous-dossiers Windows (pas de fichiers) dans un dossier précis à partir de son nom contenu dans une cellule
6 7 8
Réponses
106
Affichages
4 K
job75
H
  • Question Question
Microsoft 365 Creer un bouton VBA pour lancer une recherche
Réponses
3
Affichages
201
hanGOUP
H
F
  • Question Question
XL 2016 [VBA] Coller du texte sans formatage
Réponses
8
Affichages
197
F22Raptor
F
B
  • Question Question
XL 2013 excel Copier coller feuille avec tout le contenue
Réponses
4
Affichages
309
Bodin44
B
F
  • Question Question
XL 2016 recherche de mots
2
Réponses
19
Affichages
867
job75
R
  • Question Question
XL 2021 Recherche formule pour compléter une cellule a partir des données d'une autre feuille du classeur (16/03/2026)
2
Réponses
18
Affichages
558
laurent950
  • Résolu(e)
XL 2019 colorer les différents aliments avec un code VB pour macro de ce genre ?
2
Réponses
16
Affichages
621
anthoYS
Y
  • Question Question
Power Query Besoin d'aide pour configurer un power query
Réponses
3
Affichages
278
alexga78
A
M
  • Résolu(e)
XL 2021 Fonction pour rechercher des données, puis à reporter dans une 2ème feuille avec 1 critère
Réponses
13
Affichages
376
job75
R
  • Résolu(e)
XL 2019 recherche dans plage
Réponses
10
Affichages
583
AtTheOne
B
  • Résolu(e)
Microsoft 365 Additionner des montants par rapport a des critère.
Réponses
4
Affichages
382
blancolie
B
B
  • Résolu(e)
XL 2019 Macro pour copier des cellules d'une feuille de barèmes
Réponses
6
Affichages
320
berru76
B
  • Question Question
Microsoft 365 Excel VBA: manipuler des fichiers partagés via Teams / Sharepoint
Réponses
2
Affichages
129
Eric 888
C
  • Résolu(e)
XL 2019 Sélection en cascade ou Groupe
Réponses
12
Affichages
344
ciarab8442
C
M
  • Résolu(e)
Microsoft 365 $ Macro pour copier un exemple et$.....
Réponses
9
Affichages
516
sousou
E
  • Question Question
LibreOffice Calc Recherche sur plusieurs onglets pour constituer un tableau
Réponses
0
Affichages
313
evindi
E
F
  • Question Question
XL 2016 tableaux xl
Réponses
12
Affichages
452
TooFatBoy
  • Résolu(e)
XL 2019 macro avec fonction copié coller si rempli par la macro
Réponses
12
Affichages
646
AtTheOne
R
  • Résolu(e)
XL 2010 vba excel : recherche concordance chaine texte dans cellule et données stockées dans un tablo (array)
Réponses
4
Affichages
356
Raynaud.JF
R
F
  • Question Question
XL 2016 Recherche multi classeurs
Réponses
5
Affichages
402
mromain
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…