Macro a corriger

[BRUNO62]

Bonsoir,

J'ai besoin d'aide. Je ne n'arrive pas au résultat voulu.
Pouvez vous m'aider STP.
(Voir pièce jointe)
A+

 

[camarchepas]

Re : Macro a corriger

Bonsoir,

Voilà, juste ajouter une condition dans la 2° boucle pour passer la 3° itération sans rien faire

 

[BRUNO62]

Re : Macro a corriger

Bonjour, bonjour camarchepas.

Merci, pour ton aide.
Bonne journée.
A+

 

[BRUNO62]

Re : Macro a corriger

Bonjour,

J'ai essayé d'adapter une macro et le résultat est nul.
Avez vous une idée ?
Merci, d'avance.
A+

 

[Staple1600]

Re : Macro a corriger

Bonsoir

Avez vous une idée ?

Oui .Utiliser l'enregistreur de macros
Ce que je viens de faire
Voici ce que cela donne (code légèrement remanié)

Sub Macro1()
Range("K2").FormulaR1C1 = "=OR(RC[-7]=""U"",RC[-7]=24,RC[-7]=27)"
Range("D1:J15").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Feuil1.Range( _
        "K1:K2"), CopyToRange:=Feuil2.Range("A1"), Unique:=False
    Feuil2.Range("B:B,D:D,F:F").Delete Shift:=xlToLeft
    Feuil2.Range("A2:D4").Copy
    Feuil2.Range("A5:A8").PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
        , Transpose:=True
Feuil2.Rows("1:4").Delete Shift:=xlUp
With Feuil2.[A1].CurrentRegion
    .Interior.ColorIndex = xlNone
    .Borders.LineStyle = xlContinuous
End With
End Sub

Voici comment sont les données en Feuil1

 

[camarchepas]

Re : Macro a corriger

Bonjour,

J'avais pas lu tous l'énoncé,

Voici un solution :

 

[BRUNO62]

Re : Macro a corriger

Bonsoir,

Grand merci à camarchepas, Staple1600.
Une fois de plus, vous avez trouver la bonne solution.

Bonne soirée.
A+