Bonjour,
Voici une proposition avec en A1 la colonne de recherche et en B1 le fameux critère (texte) :
sub test()
if range("A1").value = "" then goto fin
on error goto fin
if Extraire(range("A1").value, range("B1").value) then goto fin
exit sub
fin:
msgbox "Numéro de colonne incorrect !", 16
end sub
function Extraire(colonne as long, optional critere as string = "*") as boolean
with range("Base")
if colonne > .columns.count or colonne < 1 then Extraire = true: exit function
t = .value
for i = lbound(t) to ubound(t)
if ucase(t(i, colonne)) like "*" & ucase(critere) & "*" then
n = n + 1
for k = lbound(t, 2) to ubound(t, 2)
t(n, k) = t(i, k)
next k
end if
next i
end with
with range("Extract")
if .rows.Count > 1 then .delete else .clearcontents
if n > 0 then .resize(n, ubound(t, 2)).value = t
end with
end function
La procédure ne respecte pas la casse.
Il faudra adapter les 2 noms des 2 tableaux structurés du code ("Base" contenant toutes les infos et "Extract" contenant les données filtrées).
Cdlt,
Saut Xmenpl !