problème avec vba

[marleauc]

bonjour tput le monde,

j'eprouve un certains problème avec appliqué mon vba voici celle-ci
Private Sub Worksheet_Activate()
[A1].Select
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$2" Then
Sheets("Feuil2").Range("base").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"A1:A2"), CopyToRange:=Range("A3:H3"), Unique:=False
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim ListClients As Object
Dim DerLig As Long
Dim Cel As Range
If Target.Address = "$A$2" Then
Set ListClients = CreateObject("Scripting.Dictionary")
With Sheets("Feuil2")
DerLig = .[A65000].End(xlUp).Row
.Range("A2:M" & DerLig).Name = "base"
For Each Cel In .Range("A3:A" & DerLig)
ListClients.Item(Cel.Value) = Cel.Value
Next Cel
End With
For Each it In ListClients.items
tmp = tmp & "," & ListClients.Item(it)
Next it
tmp = Right(tmp, Len(tmp) - 1)
With Target.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=tmp
End With

End If
End Sub

mon problème c'est que le résultat se trouve ici

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$2" Then
Sheets("Feuil2").Range("base").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"A1:A2"), CopyToRange:=Range("A3:H3"), Unique:=False

après avoir sélectionné la liste dans la cellule A2

merci bien de me guider....

 

[Cousinhub]

Re : problème avec vba

Bonsoir,

2 petites erreurs....

Dans la feuille 2, tu mets en en-tête : "Constable"
et dans la feuille 1, tu mets en A1 : "EMPLOYÉ"

Soit l'un, soit l'autre, mais le même....

et ensuite :

dans la zone d'extraction (CopyToRange) (définie par ton code : Range("A3:H3"), il te faut définir la zone vers laquelle tu vas extraire tes données)

dans ton cas : Range("A4 : D4") sans les espaces

le code :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$2" Then
    Sheets("Feuil2").Range("base").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
        "A1:A2"), CopyToRange:=Range("A4:D4"), Unique:=False
End If
End Sub

Bonne soirée

 

[marleauc]

merci

Fantastique , un gros merci BhBh, enfin ça fonctionne!!!

 

[Cousinhub]

Re : problème avec vba

Re-,

content que cela te convienne...

un certains problème avec appliqué mon vba

Je pense connaître ce code, donc cela n'a pas été trop difficile....

Bonne soirée

 

[marleauc]

Re : problème avec vba

excuses-moi, c'est un copain qui ma fournit un document avec cette formule... je ne savais pas que cela était toi.... merci pour le message, a l,avenir je ferai attention