Recherche multiples en VBA

Genii

XLDnaute Junior
Bonjour,
Je butte sur un problème de recherche depuis quelques jours.
Je veux importer dans un fichier des données venant de plusieurs feuilles d'un fichier excel.
J'affiche sur une feuille ma liste d'identifiants à rechercher (qui va de 1 à 10 possibilités).
Je souhaite en fonction de ces critères faire une recherche dans un autre fichier excel sur plusieurs feuilles pour copier/coller les lignes correspondantes dans une feuille du tableau inital.
Pour le moment tout ce que j'ai tenté ne marche pas. Pour le moment j'ai essayé avec find et j'ai l'impression que ca ne marche pas avec les doublons et j'en ai tout le temps.
En faisant des recherches, je suis tombé sur la méthode scrypting dictionnary mais je n'ai pas réussi à aller au bout de ce que je voulais faire avec.

Je joins un exemple pour essayer d'être clair avec le fichier de recherche (Suivi-Import) et le fichier où se trouve les données à importer (SUIVI_DATA).

Je précise que lorsque j'ai une recherche unique et pas de doublon, je n'ai pas de difficulté.

Merci d'avance.
 

Pièces jointes

  • Suivi-Import.xlsm
    50 KB · Affichages: 21
  • SUIVI_DATA.xlsx
    1.3 MB · Affichages: 30

vgendron

XLDnaute Barbatruc
Hello
un essai avec ce code
VB:
Sub recherche_pdvratt()
   
    Application.ScreenUpdating = False
   
    Dim twb As Workbook
    Set twb = ThisWorkbook
   
    Dim WbData As Workbook
   
    Dim resultat As String
    Dim tablo() As Variant
   
    'on efface la feuille de résultat
    Sheets("Import_HISTO(PDVratt)").Range("A1").CurrentRegion.Offset(1, 0).ClearContents
     
    'on récumère le numéro du magasin"
    MagasinNb = twb.Sheets("Menu").Range("C26")
    MsgBox "La recherche va s'effectuer sur le magasin rattaché n°" & MagasinNb
   
    ' on va parcourir un à un  toutes les feuilles du classeur en cours, ws identifie chacune de ces feuilles
   
    'Ouverture du fichier pour la recherche
    Workbooks.Open Filename:="\\chemindufichierexcel.xlsx"
    Set WbData = ActiveWorkbook
     
     
    With WbData
        For Each ws In .Sheets
            If ws.Name Like "B*" Then 'condition pour ne travailler que les feuilles Bxxxx
                'MsgBox ws.Name
                tablo = ws.Range("A1").CurrentRegion.Value 'on place toute la feuille dans un tablo
                For i = 1 To UBound(tablo, 1)
                    If UCase(tablo(i, 2)) <> UCase(MagasinNb) Then 'si c'est pas le bon magasin, on vide la ligne du tablo
                        For j = 1 To UBound(tablo, 2)
                            tablo(i, j) = ""
                        Next j
                    End If
                Next i
           
                 With twb.Sheets("Import_HISTO(PDVratt)") 'on recopie le tablo en fin de feuille
                    fin = .Range("A" & .Rows.Count).End(xlUp).Row + 1
                    .Range("A" & fin).Resize(UBound(tablo, 1), UBound(tablo, 2)) = tablo
                    .Range("A" & fin).Resize(UBound(tablo, 1), 1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete 'et on supprime les lignes vides
                End With
            End If
        Next ws
    End With

'    Windows("HistoData.xlsx").Activate 'fichier ouvert plus haut pour faire l'extraction des données chemindufichierexcel'
'    Application.CutCopyMode = False
'    ActiveWindow.Close
'
'
'    Sheets("Import_HISTO(PDVratt)").Select
     
    Application.ScreenUpdating = True
   
End Sub
ne fonctionne QUE pour le magasin saisi en C26
pour faire sur tout le département, il suffira de boucler sur les magasins..
 

vgendron

XLDnaute Barbatruc
avec modification de la macro qui permet de se lancer à partir d'un des deux boutons de ta feuille
si bouton "LAncer recherche sur tout le département" ==> ca boucle sur tous les magasins de la liste (zone nommée "MagsDepartement"
si bouton "Lancer la rechercher sur un Magasin ==> ca ne recherche QUE le magasin en C26
 

Pièces jointes

  • Suivi-Import.xlsm
    56.5 KB · Affichages: 38

Statistiques des forums

Discussions
311 725
Messages
2 081 943
Membres
101 849
dernier inscrit
florentMIG