Sub Extraction()
Dim Pays As String, Produit As String
Dim t, t1
Dim d As Object
Dim col As Integer, i As Integer, k As Integer
'Nous enregistrons les critères
With Sheets("Home")
Pays = .[b12].Value
Produit = .[d12].Value
End With
'Nous nous plaçons dans la feuille selon le pays
With Sheets(Pays)
'On enregistre sous forme de tableau la liste des éléments
t = .Range("a4:r" & .[r65000].End(xlUp).Row)
'Nous cherchons la colonne correspond au Produit
col = WorksheetFunction.Match(Produit, .Rows(3), 0)
If col = 0 Then MsgBox "Produit non répertorié": Exit Sub
'Nous allons mettre sous index les lignes avec "Oui" pour le produit en question
Set d = CreateObject("scripting.dictionary")
k = 0 'Nous ajoutons un compteur pour connaître le nombre de lignes avec le produit
For i = LBound(t) To UBound(t)
If t(i, col) = "Oui" Then d(1) = d(1) & i & ":": k = k + 1
Next i
If k = 0 Then MsgBox "Aucune entreprise ne vend " & Produit & " en " & Pays: Exit Sub
'Nous extrayons du premier tableau les lignes répondant au critère
t1 = Application.Index(t, Application.Transpose(Split(d(1), ":")), Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18))
End With
With Sheets("Extraction")
i = .[c65000].End(xlUp).Row + 1
'On ajoute le tableau dans la feuille extraction
.Range("a" & i).Resize(UBound(t1) - 1, 18).Value = t1
End With
End Sub
