XL 2016 recherche par macro

[eastwick]

Bonjour à toutes et tous,
Je ne parviens pas à faire une macro. Je tape un début de nom en B6, ensuite seulement, ma macro doit aller copier cette info dans l'option "contient" de la cellule B8 (liste).
Or ça ne fonctionne plus dès que je tape un autre nom que celui qui a servi pour l'enregistrement de ma macro !
Je vous remercie.

 

[sylvanu]

Bonjour Eastwick,
Donnez nous un petit fichier test, ou à défaut la macro générée.

Or ça ne fonctionne plus dès que je tape un autre nom que celui qui a servi pour l'enregistrement de ma macro !

Très probablement qu'un variable est en "dur". Il faut la modifier pour qu'elle soit universelle.

 

[eastwick]

Sub choix()
'
' choix Macro
'

'
Range("B6").Select
Selection.Copy
ActiveSheet.Range("$A$8:$N$30000").AutoFilter Field:=2, Criteria1:= _
("B6").Value, Operator:=xlAnd
Range("B7").Select
Application.CutCopyMode = False
ActiveWorkbook.Save
Range("B6").Select
End Sub

 

[sylvanu]

Re,
Peut être avec simplement :

Sub Choix()
ActiveSheet.ListObjects("Tableau1").Range.AutoFilter Field:=2, Criteria1:=Range("B6") & "*"
Range("B6") = ""
End Sub

En mettant $A$8:$N$30000 sous forme de tableau structuré.
Sinon essayez :

Sub Choix()
ActiveSheet.Range("$A$8:$N$30000").Range.AutoFilter Field:=2, Criteria1:=Range("B6") & "*"
Range("B6") = ""
End Sub

( Je n'ai pas mis ActiveWorkbook.Save pour le test, rajoutez le si besoin )
Sinon envoyez un fichier test avec des explications plus précises.

 

[sylvanu]

Re,
On peut aussi le rendre automatique, en mettant dans la feuille concernée :

Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fin: If Target.Count > 1 Or [B6] = "" Then Exit Sub
    If Not Intersect(Target, [B6]) Is Nothing Then
        Application.ScreenUpdating = False
        ActiveSheet.ListObjects("Tableau1").Range.AutoFilter _
            Field:=2, Criteria1:=Range("B6") & "*"
        Range("B6") = ""
    End If
Fin:
End Sub

 

[eastwick]

Re,
On peut aussi le rendre automatique, en mettant dans la feuille concernée :

Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fin: If Target.Count > 1 Or [B6] = "" Then Exit Sub
    If Not Intersect(Target, [B6]) Is Nothing Then
        Application.ScreenUpdating = False
        ActiveSheet.ListObjects("Tableau1").Range.AutoFilter _
            Field:=2, Criteria1:=Range("B6") & "*"
        Range("B6") = ""
    End If
Fin:
End Sub

Merci sylvanu !