recherche et addition multicritére

Sub Bouton1_QuandClic()
Dim tablo As Variant
Dim tablores() As String
Dim x As Integer, i As Integer
Dim j As Byte

'on crée un tableau variant
tablo = Range('a1:j' & Range('j65536').End(xlUp).Row) ' a adapter
x = 1

'pour chasue ligne du tableau
For i = 1 To UBound(tablo)
    'si la donnée ce trouvant en colonne 4 = 1250465 alors
    If tablo(i, 4) = 1250465 Then
        'on 'aggrandi' le tableau de résultat
        ReDim Preserve tablores(1 To 10, 1 To x)
        'on boucle pour récupérer les valeurs de la ligne
        For j = 1 To 10
            tablores(j, x) = tablo(i, j)
        Next j
        x = x + 1
    End If
'prochaine ligne
Next i

'en feuille 2 on renvoi le tableau de résultat
Sheets('feuil2').Range('a1').Resize(UBound(tablores, 2), UBound(tablores, 1)) = Application.WorksheetFunction.Transpose(tablores)
End Sub

Cliquez pour agrandir...