Besoin d'aide pour un "recherche-coller"

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

  • essai.xls
    36 KB · Affichages: 64
  • essai.xls
    36 KB · Affichages: 66
  • essai.xls
    36 KB · Affichages: 68
Trier par date Trier par votes
R

rainbow69006

XLDnaute Occasionnel
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
skoobi

skoobi

XLDnaute Barbatruc
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
R

rainbow69006

XLDnaute Occasionnel
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
R

rainbow69006

XLDnaute Occasionnel
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

  • book.zip
    18.9 KB · Affichages: 14
  • book.zip
    18.9 KB · Affichages: 14
  • book.zip
    18.9 KB · Affichages: 22
Vote positif 0 Vote négatif
skoobi

skoobi

XLDnaute Barbatruc
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

Discussions similaires

P
  • Question
Microsoft 365 Besoin d'aide pour plusieurs petite chose technique sur un fichier excel
8 9 10
Réponses
136
Affichages
7 K
TooFatBoy
TooFatBoy
C
  • Résolu(e)
XL 2010 Recherche
Réponses
2
Affichages
229
CATPLUS
C
frasylest
  • Résolu(e)
Microsoft 365 Formulaire de recherche avec résultat dans autre formulaire
Réponses
2
Affichages
286
frasylest
frasylest
P
  • Question
XL 2021 Code VBA pour copier coller des données de cellules d'une feuille a une autre
Réponses
4
Affichages
345
phoceenjo
P
C
  • Question
XL pour MAC Lien Hypertexte
Réponses
2
Affichages
443
christophe43333333
C
B
  • Résolu(e)
Microsoft 365 Recherche dans tableaux suivant 4 critères
2
Réponses
15
Affichages
620
Blf57
B
G
  • Question
XL 2021 rassembler des données de plusieurs feuilles d'un classeur sur une nouvelle feuille du meme classeur selon un critère
Réponses
1
Affichages
219
Staple1600
Staple1600
S
  • Question
XL 2016 aditionner et soustraire des heures en fonction d'un critère
Réponses
2
Affichages
294
shushen
S
M
  • Question
Microsoft 365 Recopie ligne avec un code GOOGLE SHEET
Réponses
7
Affichages
239
Moreno076
M
B
  • Question
XL 2016 recherche dans une colonne depuis un autre onglet
Réponses
5
Affichages
203
boguinette
B

Membres actuellement en ligne

17 membres et 161 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 777
Messages
2 092 032
Membres
105 159
dernier inscrit
frontera930