Recherche avec plusieurs résultats (valeurs uniques) renvoyés

Bonjour

J'espère que vous allez bien, et que je pourrai trouver une solution à mon problème.

Je souhaite effectuer 'une recherche avec plusieurs résultats (valeurs uniques) renvoyés.

Mon fichier comporte deux feuilles : Données et Alpes Provence

Sur ma feuille Données, j'ai deux colonnes : Entités et Fruits

Sur ma feuilles Alpes Provence, je souhaite ramener dans la Colonne A, à partir de la cellule A5, tous les fruits de l'entité Alpes Provence de tel sorte à avoir des valeurs uniques.

Quelqu'un a t il un code VBA qui pourrait m'aider svp?

Merci pour votre aide

Bonjour,

Voici une solution possible avec un TCD.

Bonjour Oliblast,

Merci pour ta réponse, mais je veux le faire avec un code VBA, de manière à l'automatiser au maximum.

Bonjour,

Un code comme ceci fonctionne.

C'est pas l'idéal, j'imagine qu'il faudrait plus bosser en tableau virtuel que de passer par du dur comme ça, mais si ça peut dépanner ...

Sub alpes_provence()
'
Dim ws1, ws2 As Worksheet

Set ws1 = Sheets(1)
Set ws2 = ActiveSheet

Application.ScreenUpdating = False
ws2.Range("A5:A" & Range("A4").End(xlDown).Row).ClearContents
With ws1
    .Range("A:B").Copy Destination:=ws1.Cells(1, 5)
    .Range("E:F").RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
    .Range("$E$1:$F" & Range("F1").End(xlDown).Row).AutoFilter Field:=1, Criteria1:= _
        "Alpes Provence"
    .Range("F:F").SpecialCells(xlCellTypeVisible).Copy Destination:=ws2.Range("A4")
    .Columns("E:F").Delete
End With
Application.ScreenUpdating = True
End Sub

Bonjour JoyeuxNoel,

Merci pour ton aide.

La donnée "Alpes Provence" en cellule B1 de la feuille "Alpes Provence", est une donnée qui peut changer, elle n'est pas figée. On peut avoir "Chalus" par exemple. Aurais tu une idée de comment y arriver?

Merci

C'était trop simple de préciser ça avant, j'imagine !
Pourquoi ton onglet s'appelle alpes provence alors ?

Dans le module1 en remplacement de l'ancienne macro :

Sub fruits()
'
Dim ws1, ws2 As Worksheet
Dim fruit As String
Set ws1 = Sheets(1)
Set ws2 = ActiveSheet
fruit = Cells(1, 2).Value
If Application.CountIf(ws1.Range("A:A"), fruit) = 0 Then
ws2.Range("A5:A" & Range("A4").End(xlDown).Row).ClearContents
Exit Sub
Else:
Application.ScreenUpdating = False
ws2.Range("A5:A" & Range("A4").End(xlDown).Row).ClearContents
With ws1
    .Range("A:B").Copy Destination:=ws1.Cells(1, 5)
    .Range("E:F").RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
    .Range("$E$1:$F" & Range("F1").End(xlDown).Row).AutoFilter Field:=1, Criteria1:=fruit
    .Range("F:F").SpecialCells(xlCellTypeVisible).Copy Destination:=ws2.Range("A4")
    .Columns("E:F").Delete
End With
End If
Application.ScreenUpdating = True
End Sub

et dans le module de ta feuille alpes provence :

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B1")) Is Nothing Then
Call fruits
End If
End Sub

Merci JoyeuxNoel. Tu gères :)

Bonjour,

Comme dit précédemment, ça serait mieux en bossant en mémoire, mais je ne sais pas assez bien faire.