Amélioration rapidité pour trie de lignes

Bonjour,

J'ai fais une macro qui me permet de faire un trie de lignes, suivant le texte qui se trouve dans une cellule(PASS OU *FAIL*). Si la cellule est "PASS" la ligne est copiée dans la "feuille client" et si elle est "*FAIL*" la ligne est copiée dans la feuille "valeurs mauvaises" . La macro étant lente je cherche à la rendre plus rapide mais ne connaissant pas trop la programmation VBA j'ai un peu de mal.

Je me tourne vers vos connaissance afin d'avoir de l'aide pour améliorer cet macro.

Voici le code:

Sub triage_cellule()

'la première partie correspond au triage des valeurs bonnes et mauvaises.
'pour cela j'utilise une boucle for et des conditions.
'programme trop lent, plusieurs seconde
'
Dim cellule1
Dim cellule2
Dim celule3

For i = 23 To 500

cellule1 = Sheets("mesures Brutes").Cells(i, 4).Value

  'dans un premier temps je regarde quand la cellule=pass et si cela correspond je la copie dans la feuille client:
  '

  If cellule1 = "Pass" Then

Sheets("mesures Brutes").Select
Rows(i).Select
Selection.Copy   'on copie la ligne
Sheets("feuille client").Select
Rows(i).Select 'on selectionne la ligne
Sheets("feuille client").Paste 'on colle la sélection

cellule2 = Sheets("feuille client").Cells(i, 4).Value

If cellule2 = "" Then
Rows(i).Select
Selection.Delete (xlShiftUp)

End If

'si elle n'est pas égale à pass et quel est fAIL(ne correspond pas au cahier des charges défini),
'on la copie dans la feuille "valeurs mauvaise"
'

Else
Sheets("mesures Brutes").Select
Rows(i).Select
Selection.Copy
Sheets("valeurs mauvaises").Select
Rows(i).Select
Sheets("valeurs mauvaises").Paste

'on supprime quand c'est vide

cellule3 = Sheets("valeurs mauvaises").Cells(i, 4).Value
If cellule3 = "" Then
Rows(i).Select
Selection.Delete (xlShiftUp)
End If

End If

Next

'

End Sub

En vous remercient d'une réponse.

Cordialement.

Maxime

Maxime,

Essaie ce genre de code et vois si ça va plus vite :

Sub LinesDispatcher()

Const cColFilter = 3

Dim oSheetMesures As Excel.Worksheet

Dim oSheetPASS As Excel.Worksheet

Dim oSheetFAIL As Excel.Worksheet

Dim oRange As Excel.Range

Set oSheetMesures = ThisWorkbook.Worksheets(1)

Set oSheetPASS = ThisWorkbook.Worksheets(2)

Set oSheetFAIL = ThisWorkbook.Worksheets(3)

'Effacer les filtres préexistants

oSheetMesures.AutoFilterMode = False

'Filtrer sur "Pass"

Set oRange = oSheetMesures.UsedRange

oRange.AutoFilter cColFilter, "=Pass", xlFilterValues

oRange.Copy oSheetPASS.Cells(1, 1)

'Effacer les filtres préexistants

oSheetMesures.AutoFilterMode = False

'Filtrer sur "Fail"

oRange.AutoFilter cColFilter, "=Fail", xlFilterValues

oRange.Copy oSheetFAIL.Cells(1, 1)

oSheetMesures.AutoFilterMode = False

Bonjour,

le copie-coller des lignes ne se fait pas quand je lance la macro.

cordialement.

Maxime

Bonjour Maxime,

Je viens de tester ce code à nouveau sous EXCEL 2007 et il fonctionne comme attendu.

Je joins mon classeur de test.

Vérifies la valeur des filtres dans ton propre EXCEL et s'ils sont différents de "Pass" et "Fail", modifies-les dans la macro.

Mon classeur test.

Merci, je vais essayé de l'adapter à ma macro.

Cordialement.

Maxime