Probleme elaboration d'une MACRO

Bonjour tout le monde,

Je viens de créer une macro nommée TEST (qui ne fonctionne pas) sous excel ayant pour but de rechercher des valeurs dans une bdd selon 4 criteres.

Feuil1 : ma bdd

Feuil2 : un tableau presentant le profil recherché + un tableau presentant le(s) profil(s) selectionné(s) grace à la macro

L'objectif est de trouver parmi cette BDD, la ou les personnes pouvant correspondre au profil exposé selon 4 criteres Sexe, Age, PA et Groupe, en ayant comme marge de +/-5 sur les criteres suivants (Age, PA).

Je vous transmets en Pj le fichier xls.

En vous remerciant par avance.

Marc

Sub TEST()

Dim i As Long

Application.ScreenUpdating = False

Sheets("Feuil2").Range("J3:R800").ClearContents

intervalle = Sheets("Feuil2").Range("E11")

sexe = Sheets("Feuil2").Range("D3")

age = Sheets("Feuil2").Range("E3")

pa = Sheets("Feuil2").Range("F3")

groupe = Sheets("Feuil2").Range("G3")

k = 4

With Sheets("Feuil1")

For i = 4 To .Range("A" & .Rows.Count).End(xlUp).Row

If (.Cells(i, 5) >= age - intervalle And .Cells(i, 5) <= age + intervalle) And .Cells(i, 4) = sexe And (.Cells(i, 8) <= tabac + intervalle And .Cells(i, 8) >= tabac - intervalle) Then

Sheets("Feuil2").Cells(k, 10) = .Cells(i, 1)

Sheets("Feuil2").Cells(k, 11) = .Cells(i, 2)

Sheets("Feuil2").Cells(k, 12) = .Cells(i, 3)

Sheets("Feuil2").Cells(k, 13) = .Cells(i, 4)

Sheets("Feuil2").Cells(k, 14) = .Cells(i, 5)

Sheets("Feuil2").Cells(k, 15) = .Cells(i, 6)

Sheets("Feuil2").Cells(k, 16) = .Cells(i, 7)

Sheets("Feuil2").Cells(k, 17) = .Cells(i, 8)

Sheets("Feuil2").Cells(k, 18) = .Cells(i, 9)

k = k + 1

End If

Next i

End With

Application.ScreenUpdating = True

End Sub

Pour être précis :Je viens de te créer ta macro

Tu as juste à modifier le décalement des cellules. Mais comme en plus de t'attribuer le travail des autres tu ne fais pas l'effort d'essayer de comprendre pour adapter, je te le fais à nouveau:

Sub TEST()
    Dim i As Long, k As Long
    Application.ScreenUpdating = False
    Sheets("Feuil2").Range("J3:R800").ClearContents
    intervalle = Sheets("Feuil2").Range("E11")
    sexe = Sheets("Feuil2").Range("D3")
    age = Sheets("Feuil2").Range("E3")
    pa = Sheets("Feuil2").Range("F3")
    groupe = Sheets("Feuil2").Range("G3")
    k = 3
    With Sheets("Feuil1")
        For i = 4 To .Range("A" & .Rows.Count).End(xlUp).Row
            If (.Cells(i, 5) >= age - intervalle And .Cells(i, 5) <= age + intervalle) And .Cells(i, 4) = sexe And (.Cells(i, 8) <= pa + intervalle And .Cells(i, 8) >= pa - intervalle) And .Cells(i, 9) = groupe Then
                Sheets("Feuil2").Cells(k, 10) = .Cells(i, 1)
                Sheets("Feuil2").Cells(k, 11) = .Cells(i, 2)
                Sheets("Feuil2").Cells(k, 12) = .Cells(i, 3)
                Sheets("Feuil2").Cells(k, 13) = .Cells(i, 4)
                Sheets("Feuil2").Cells(k, 14) = .Cells(i, 5)
                Sheets("Feuil2").Cells(k, 15) = .Cells(i, 6)
                Sheets("Feuil2").Cells(k, 16) = .Cells(i, 7)
                Sheets("Feuil2").Cells(k, 17) = .Cells(i, 8)
                Sheets("Feuil2").Cells(k, 18) = .Cells(i, 9)
                k = k + 1
            End If
        Next i
    End With
    Application.ScreenUpdating = True
End Sub