Copier Coller suivant Condition

[niepce26]

Bonsoir,

Je cherche une solution (vba ou non) afin de faire un copier dans un tableau (Feuille Saisie) pour le coller sur une autre feuille (Résultat) suivant un critère "profession".

J'ai vu des solutions avec la formule Index mais ne suis pas arrivé à la mettre en œuvre.

Ci-joint mon fichier, si quelqu'un peut me donner une piste...

Merci.

Niepce

 

[DoubleZero]

Re : Copier Coller suivant Condition

Bonjour, niepce26, le Forum,

Une proposition dans le fichier joint.

Sub Professions()

Dim c As Range
Application.ScreenUpdating = False
Range("k:k").Insert
Range("b:d").Clear

Sheets("Saisie").Range("Profession").AdvancedFilter Action:=xlFilterCopy, _
    CopyToRange:=Range("k1"), Unique:=True

Range("k:k").Sort Range("k1"), xlAscending, Header:=xlYes

Do While Range("K2") <> ""
Range("b65536").End(3)(6) = Range("d2")
Sheets("Saisie").Range("b4").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("k1:k2"), CopyToRange:=Range("b65536").End(3)(7), Unique:=False
Range("K2").Delete Shift:=xlUp
Loop

Range("k:k").Delete

For Each c In Range("b2", [b65000].End(xlUp))
If c.Offset(1, 0) = "Nom" Then
With c
.Value = c.Offset(2, 1)
.Interior.ColorIndex = 6
.Borders.Value = 1
End With
End If
Next

Range("c:c").Delete

For Each c In Range("b2", [b65000].End(xlUp))
If c = "Nom" Then c.EntireRow.Delete
Next

Cells.EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub

A bientôt

 

[niepce26]

Re : Copier Coller suivant Condition

Merci DoubleZero pour cette réponse.

Sa correspond exactement à mon attente.

Bonne soirée.

Niepce26