Ameliorer code VBA

Bonjour à tous,

J'ai un code VBA qui ne fonctionnent pas entièrement et je n'arrive après plusieurs essais

1-Le copiage des données selon les critères ne fonctionnent pas (Pas de NA colonne K, Pas de de 0 colonne J, Prendre tous les G* colonne O

2-Après avoir copié sur une feuille 5 je souhaite que sa colle sur Feuille 6

3-Pouvoir faire un tri croissant colonne H

En pièce jointe le document

Merci d'avance pour toute aide

BOUBOU

Sub Rectangle9_Cliquer()
i = 6
j = 6
While Feuil2.Range("B" & i) <> ""

If Feuil2.Range("B" & i) = "CWB" And Feuil2.Range("C" & i) = "PEC-EBAUCHE" Or Feuil2.Range("C" & i) = ("PEC-FINITION") And Feuil2.Range("H" & i) = "<> NA" And Feuil2.Range("J" & i) <> 0 And (Feuil2.Range("O" & i) = "G*") Then

Feuil5.Range("C" & j) = Feuil2.Range("C" & i)
Feuil5.Range("D" & j) = Feuil2.Range("D" & i)
Feuil5.Range("E" & j) = Feuil2.Range("E" & i)
Feuil5.Range("F" & j) = Feuil2.Range("F" & i)
Feuil5.Range("G" & j) = Feuil2.Range("G" & i)
Feuil5.Range("H" & j) = Feuil2.Range("H" & i)
Feuil5.Range("I" & j) = Feuil2.Range("I" & i)
Feuil5.Range("J" & j) = Feuil2.Range("J" & i)
Feuil5.Range("K" & j) = Feuil2.Range("K" & i)
Feuil5.Range("L" & j) = Feuil2.Range("L" & i)
Feuil5.Range("M" & j) = Feuil2.Range("M" & i)
Feuil5.Range("N" & j) = Feuil2.Range("N" & i)
Feuil5.Range("O" & j) = Feuil2.Range("O" & i)
Feuil5.Range("P" & j) = Feuil2.Range("P" & i)
Feuil5.Range("Q" & j) = Feuil2.Range("Q" & i)
Feuil5.Range("R" & j) = Feuil2.Range("R" & i)

j = j + 1

End If

i = i + 1

Wend

While Feuil2.Range("B" & i) <> ""

If Feuil2.Range("B" & i) = "KB" And Feuil2.Range("C" & i) = "PEC-EBAUCHE" Or Feuil2.Range("C" & i) = ("PEC-FINITION") And Feuil2.Range("H" & i) = "<> NA" And Feuil2.Range("J" & i) <> 0 And (Feuil2.Range("O" & i) = "G*") Then

Feuil6.Range("C" & j) = Feuil2.Range("C" & i)
Feuil6.Range("D" & j) = Feuil2.Range("D" & i)
Feuil6.Range("E" & j) = Feuil2.Range("E" & i)
Feuil6.Range("F" & j) = Feuil2.Range("F" & i)
Feuil6.Range("G" & j) = Feuil2.Range("G" & i)
Feuil6.Range("H" & j) = Feuil2.Range("H" & i)
Feuil6.Range("I" & j) = Feuil2.Range("I" & i)
Feuil6.Range("J" & j) = Feuil2.Range("J" & i)
Feuil6.Range("K" & j) = Feuil2.Range("K" & i)
Feuil6.Range("L" & j) = Feuil2.Range("L" & i)
Feuil6.Range("M" & j) = Feuil2.Range("M" & i)
Feuil6.Range("N" & j) = Feuil2.Range("N" & i)
Feuil6.Range("O" & j) = Feuil2.Range("O" & i)
Feuil6.Range("P" & j) = Feuil2.Range("P" & i)
Feuil6.Range("Q" & j) = Feuil2.Range("Q" & i)
Feuil6.Range("R" & j) = Feuil2.Range("R" & i)
j = j + 1

End If

i = i + 1

Wend

End Sub

Bonjour

Après le premier WEND, remets i et J à la valeur 6

Sub Rectangle9_Cliquer()
....
i = i + 1

Wend
i = 6
j = 6
While Feuil2.Range("B" & i) <> ""
.....
End sub

Si ok, clique sur le vert à coté du bouton EDITER lors de ta réponse afin de clôturer le fil

Cordialement

Bonjour,

Bonjour Dan,

Essaie ainsi :

Option Explicit

Sub Rectangle9_Cliquer()
Dim i As Long, j As Long

    Application.ScreenUpdating = False

    i = 6
    j = 6

    While feuil2.Range("B" & i) <> ""

        If feuil2.Range("B" & i) = "CWB" And feuil2.Range("C" & i) = "PEC-EBAUCHE" Or feuil2.Range("C" & i) = ("PEC-FINITION") And feuil2.Range("H" & i) = "<> NA" And feuil2.Range("J" & i) <> 0 And (feuil2.Range("O" & i) = "G*") Then

            feuil5.Range("C" & j & ":R" & j).Value = feuil2.Range("C" & i & ":R" & i).Value

            j = j + 1

        End If

        i = i + 1

    Wend

    i = 6
    j = 6

    While feuil2.Range("B" & i) <> ""

        If feuil2.Range("B" & i) = "KB" And feuil2.Range("C" & i) = "PEC-EBAUCHE" Or feuil2.Range("C" & i) = ("PEC-FINITION") And feuil2.Range("H" & i) = "<> NA" And feuil2.Range("J" & i) <> 0 And (feuil2.Range("O" & i) = "G*") Then

            feuil6.Range("C" & j & ":R" & j).Value = feuil2.Range("C" & i & ":R" & i).Value

            j = j + 1

        End If

        i = i + 1

    Wend

End Sub
Rechercher des sujets similaires à "ameliorer code vba"