VBA trier suivant contenu alphabetique d'une celllule

[rico83600]

Bonjour,

le code ci dessous me permet d analyser un tableau dans ma feuille 2, et de copier/coller toutes les lignes dont la somme de la colonne 9 est inférieure à 88 dans la feuille 3, et toutes les autres dans la feuille 4 (j'ai recopié ce code sur le net).

Cependant moi je voudrais remplacer ce 88 par RRR.
Donc si ma cellule en colonne 9 contient le texte "RRR" alors il me recopie la ligne dans la feuille 3, sinon dans la feuille 4 (ou le contraire, c'est pas important)

J'ai essayé de mettre don = "EM" ou don = EM ou don = 'EM', rien n'y fait ca marche pas..

Merci d'avance

Private Sub CommandButton1_Click()
 Dim don As Long
   Dim ligne As Long
   Dim compteurFeuille3 As Long
   Dim compteurFeuille4 As Long
   don = 88
   compteurFeuille3 = 1
   compteurFeuille4 = 1
   For i = 2 To 6
      Worksheets(2).Range("A" & i & ":K" & i).Copy
      If Cells(i, 9) = don Then
         Worksheets(4).Range("A" & compteurFeuille4).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
         False, Transpose:=False
         compteurFeuille4 = compteurFeuille4 + 1
      Else
         Worksheets(3).Range("A" & compteurFeuille3).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
         False, Transpose:=False
         compteurFeuille3 = compteurFeuille3 + 1
      End If
   Next i
   Worksheets(2).Range("A2").Select
End Sub

 

[tototiti2008]

Re : VBA trier suivant contenu alphabetique d'une celllule

Bonjour rico,

peut-être

Private Sub CommandButton1_Click()
Dim don As String
Dim ligne As Long
Dim compteurFeuille3 As Long
Dim compteurFeuille4 As Long
don = "RRR"
compteurFeuille3 = 1
compteurFeuille4 = 1
For i = 2 To 6
Worksheets(2).Range("A" & i & ":K" & i).Copy
If Cells(i, 9) = don Then
Worksheets(4).Range("A" & compteurFeuille4).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
compteurFeuille4 = compteurFeuille4 + 1
Else
Worksheets(3).Range("A" & compteurFeuille3).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
compteurFeuille3 = compteurFeuille3 + 1
End If
Next i
Worksheets(2).Range("A2").Select
End Sub