jeanlouispaf
XLDnaute Nouveau
Bonjour à tous les excelliens
Je souhaite modifier une macro de l'excellentissime J. Boisgontier.
Malheureusement je me heurte à chaque fois à la même réponse.
Dans le fichier joint, je souhaite procéder à une extraction dynamique.
Dès qu'une nouvelle valeur est inscrite en colonne C, elle doit s'ajouter à la liste de valeurs en colonne I.
J'ai beau changer le paramètre "Target.Column = 2" en remplaçant la valeur 2 par 3, la colonne I s'enrichit toujours de la valeur de la colonne 2.
Je vous remercie de votre aide précieuse.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 And Target.Count = 1 Then
Application.EnableEvents = False
'[G3] = Empty
[A11000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[I1], Unique:=True
[I2:I1000].Sort Key1:=[I2]
Application.EnableEvents = True
End If
'--- extraction des personnes d'un service
Set f = Sheets("bd")
If Target.Address = "$G$3" And [G3] <> "" Then
temp = Target.Value
témoin = False
For i = 1 To Sheets.Count
If Sheets(i).Name = temp Then témoin = True
Next i
If Not témoin Then
Sheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = temp
Else
Sheets(temp).Select
End If
f.[A11000].AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=f.[G2:G3], _
CopyToRange:=Sheets(temp).[A11]
[A21000].Sort Key1:=[A2]
End If
End Sub
Je souhaite modifier une macro de l'excellentissime J. Boisgontier.
Malheureusement je me heurte à chaque fois à la même réponse.
Dans le fichier joint, je souhaite procéder à une extraction dynamique.
Dès qu'une nouvelle valeur est inscrite en colonne C, elle doit s'ajouter à la liste de valeurs en colonne I.
J'ai beau changer le paramètre "Target.Column = 2" en remplaçant la valeur 2 par 3, la colonne I s'enrichit toujours de la valeur de la colonne 2.
Je vous remercie de votre aide précieuse.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 And Target.Count = 1 Then
Application.EnableEvents = False
'[G3] = Empty
[A11000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[I1], Unique:=True
[I2:I1000].Sort Key1:=[I2]
Application.EnableEvents = True
End If
'--- extraction des personnes d'un service
Set f = Sheets("bd")
If Target.Address = "$G$3" And [G3] <> "" Then
temp = Target.Value
témoin = False
For i = 1 To Sheets.Count
If Sheets(i).Name = temp Then témoin = True
Next i
If Not témoin Then
Sheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = temp
Else
Sheets(temp).Select
End If
f.[A11000].AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=f.[G2:G3], _
CopyToRange:=Sheets(temp).[A11]
[A21000].Sort Key1:=[A2]
End If
End Sub