Ameliorer code VBA
B
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