VBA recherchev** dans feuilles autre classeur [Résolu/Fermé]

Signaler
-
Messages postés
8700
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
-
Bonjour,


Je seche sur VBA....Merci du fond du coeur pour votre aide.

Je veux faire une recherchev d'une valeur (source) dans toutes les feuilles d'un autre classeur (cible).
la source se trouve en A1
la cible se trouve en colonne A,
Je veux renvoyer en A3 la ligne entière ou se trouve la cible (recherchev normal dans un classeur entier)

Là ou ça se gate pour moi, c'est que ma valeur cible apparaît au moins 2 fois...
Ma source est en fait le numéro d'une écriture comptable et je veux donc renvoyer l'intégralité de l'écriture qui peut avoir 10 lignes, voire plus.

J'ai donc programmé non pas une recherchev en VBA mais un listage des coordonnées ou se trouve la cible (je n'obtient que les numéros ligne et pas encore le nom de la feuille) pour ensuite copier/coller les cellules à droite de ma cible (Je me suis inspiré de la fonction que j'ai trouvé sur :
http://www.commentcamarche.net/forum/affich-2265048-vba-excel-selection-multiple-de-feuilles )

Cela fonctionne très bien en définissant la feuille du classeur cible mais pas en voulant "balayer" l'ensemble des feuilles.

Voici mon code, merci pour votre aide.
Je ne sais plus quoi faire...

FONCTION PROGRAMMEE POUR ETRE APPELEE ENSUITE (ENREGISTREE EN MODULE)

Sub Macro1()
'Retourne toutes les adresses trouvées dans la recherche
'WkbN = nom du classeur, avec cette donnée la fonction peut être mise dans un xla
'WksN = nom de la feuille
'Plage = les coordonnées de la plage à parcourir.
'Retour dans le tableau donner en argument.


Function RechFind(ByVal Cle As String, ByVal WkbN As String, ByVal WksN As String, ByVal Plage As String, ByRef TBadress() As Variant) As Long
Dim cherche, Ix As Long, PrAddress
Dim J As Integer


With Workbooks("WORKBOOK CIBLE").Sheets("FEUILLE CIBLE").Range(Plage)
Set cherche = .Find(Cle)
If Not cherche Is Nothing Then
PrAddress = cherche.Address
Do
ReDim Preserve TBadress(Ix)
TBadress(Ix) = cherche.Address
Set cherche = .FindNext(cherche)
Ix = Ix + 1
Loop While Not cherche Is Nothing And cherche.Address <> PrAddress
End If
End With
'nombre d'occurence(s) trouvée(s), Retour 0 si aucune occurence
RechFind = Ix
Set cherche = Nothing 'Libére la mémoire occupée par l'objet.


End Function

BOUTON DE COMMANDE EN USERFORM POUR LISTER LES REFERENCES (APPEL DE LA FONCTION PRECEDENTE )


Dim R As Long, TB()
Dim i As Integer



R = RechFind(Range("a1"), ThisWorkbook.Name, ActiveSheet.Name, Range("A1:A65536").Address, TB())

If R > 0 Then
For i = 0 To R - 1 ' ou ubound(TB)
'exemple
Sheets("FEUILLE SOURCE").Cells(i + 3, 1) = Range(TB(i)).Row
Next i

End If


Private Sub CommandButton6_Click()

BOUTON DE COMMANDE EN USERFORM POUR RENVOYER LES DONNEES DES COORDONNEES IDENTIFIEES

ligne = 3

'recopie des libellé des colonnes
Cells(2, "b") = Workbooks("WORKBOOK CIBLE").Sheets("FEUILLE CIBLE").Cells(1, "b")

'recopie de la 1ere valeur à droite de la cible
For Each c In Range("A3", [A65000].End(xlUp))
d = c.Value
Cells(ligne, "b") = Workbooks("WORKBOOK CIBLE.xls").Sheets("FEUILLE CIBLE").Cells(d, "b")



ligne = ligne + 1
Next c


End Sub

Je pense qu'il me manque 2 choses :

balayer les feuilles du Workbook-cible
récupérer le nom de la feuille ou se trouve ma cible




<config>Windows XP, Office 2003

3 réponses

Messages postés
12186
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
15 octobre 2020
2 512
Bonjour,
Si tu veux "balayer" toutes les feuilles du classeur cible :
Dim Wsh As Worksheet

For Each Wsh in ThisWorkbook.WorkSheets
'blabla
Next

Ce qui devrait pouvoir s'adapter au code de ton bouton de commande :

Dim R As Long, TB() 
Dim i As Integer 
Dim Wsh As Worksheet

For Each Wsh in ThisWorkbook.WorkSheets
    R = RechFind(Range("a1"), ThisWorkbook.Name, Wsh.Name, Range("A1:A65536").Address, TB()) 
    If R > 0 Then 
        For i = 0 To R - 1 ' ou ubound(TB) 
            'exemple 
            Sheets("FEUILLE SOURCE").Cells(i + 3, 1) = Range(TB(i)).Row 
        Next i
    End If
Next

Ou en tout cas quelque chose d'approchant.....
Bonjour pijaku,

Merci pour ton aide.
Je suis au taff, je regarderai le code ce soir.
Merci encore !
pijaku, j'ai essayé ta marco mais le modul me bug .... je vais faire avec le code de lermite222 ça m'a lair beaucoup plus simple que ce que j'avaispréparé.

Merci tout de meme
Messages postés
8700
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
1 125
Bonjour,
Il me semble que tu complique bien la chose..
tu dis...
Là ou ça se gate pour moi, c'est que ma valeur cible apparaît au moins 2 fois...
Ma source est en fait le numéro d'une écriture comptable et je veux donc renvoyer l'intégralité de l'écriture qui peut avoir 10 lignes, voire plus.

Ces lignes sont contigues ? elle peuvent se trouver sur une seule feuille ou plusieurs ?
"L'autre classeur" .. c'est toujours le même ?
A+
Salut lermite,

J ai essayé d être le plus claire possible vu l heure...
En effet les lignes sont à la suite (le nombre de ligne est variable d une écritures à l autre) mais une écriture sera toujours dans une seule feuille.

J ai relu mon mail rapidement, il me semble que je ne précise "autre classeur" qu une seule fois, je parlais donc de la cible.


Je baragouine le vba, j ai monté ma macro en fonction des codes que j ai pu glané sur le web. Je suis persuadé d avoir monte une belle usine à gaz... Mais bon ça marche a moitie comme ça. Si je peux éviter de tout reprendre je préfèrerais...

Merci encore
Messages postés
8700
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
1 125
Une macro qui devrait remplacer tout ton code...
Sub ChercheCode()
Dim WkoCible As Workbook
Dim B As Boolean
Dim WCible As Worksheet
Dim WCopie As Worksheet
Dim Lig As Long
Dim LigCopie As Integer
Dim Filtre As String
    Set WCopie = ThisWorkbook.Sheets("Feuil1")
    Filtre = WCopie.[A1]
    LigCopie = 3
    Set WkoCible = Workbook("Chemin+NomComplet+extention")
    
    For Each WCible In WkoCible.Worksheets
        With WCible
            For Lig = 1 To .Range("A65536").End(xlUp).Row
                If .Cells(Lig, "A") = Filtre Then
                    B = True
                    .Rows(Lig).Copy WCopie.Rows(LigCopie)
                    LigCopie = LigCopie + 1
                ElseIf B = True Then
                    Exit Sub
                End If
            Next Lig
        End With
    Next WCible
    MsgBox "Aucune concordance trouvée"
End Sub

Adapter le nom de la feuille (Feuil1) à la feuille où se trouve la cellule filtre.
Le classeur cible doit être ouvert. Si ce n'est pas le cas, tu dis, ont l'ouvrira.
Fonctionnement,
Recherche dans toutes les feuilles du classeur cible, quand une concordance est trouvée copie la ligne dans le classeur source en commençant par A3, si plusieurs lignes, les écrit à la suite l'une de l'autre.. A4..A5.. etc.
J'ai pas tester, quelque erreur de syntaxe ont pu se glisser, si c'est le cas tu dis sur quel ligne de code et le libellé de l'erreur.
A+
salut Lermite,

J'ai une erreur de compilation "Sub ou Fonction non définie" à la ligne suivante, concernant le Workbook :

LigCopie = 3
Set WkoCible = Workbook("P:\MACRO\cible.xls")

For Each WCible In WkoCible.Worksheets
Bon en fait, j'ai rajouté un S et ca marche nikel.

Je vais me convertir au Lermite222 !
Messages postés
8700
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
1 125
Beh oui, erreur de syntaxe, enfin, tant mieux si ça marche nickel.
Et je te remercie d'avoir bien voulu employer ma macro.