Copier/Coller lignes sous conditions dans Excell

Signaler
Messages postés
6
Date d'inscription
vendredi 17 février 2006
Statut
Membre
Dernière intervention
7 février 2011
-
Messages postés
17
Date d'inscription
jeudi 13 février 2003
Statut
Membre
Dernière intervention
29 octobre 2006
-
Bonjour,

Voiçi un petit code qui permet via un bouton de trier les données d'un tableau et de les dispatcher dans deux autre feuilles.

Sachent que la première ligne est pour les titres des collones, on commence à la seconde ligne. La variable "don" est ma condition. Je n'annalyse que les 150 première lignes du tableau. Si les valleur dans les case de la 9 ème colonne sont < à ma variable don, je copie la ligne et la colle dans une feuile, même chose si la valleur est > à la variable.

Il y a moyen de faire un tri automatique à la fin de la comparaisonce qui aura pour effet de rassembler toutes les données vers le haut de la feuille et pas dicéminée dans tout le tableau.

Voilà.

Aller.

@@++

Nicostrong

Private Sub CommandButton3_Click()
    Dim don
    Dim ligne
    don = 120
    For i = 2 To 150
        If Cells(i, 9) < don Then
            Worksheets(2).Range("A" &amp; i &amp; ":K" &amp; i).Copy
            Worksheets(4).Range("A" &amp; i).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
        Else
            Worksheets(2).Range("A" &amp; i &amp; ":K" &amp; i).Copy
            Worksheets(3).Range("A" &amp; i).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
        End If
    Next i
    Worksheets(2).Range("A2").Select
End Sub

1 réponse

Messages postés
17
Date d'inscription
jeudi 13 février 2003
Statut
Membre
Dernière intervention
29 octobre 2006

Pourquoi utilise tu i comme index de position dans feuille destination ... tu peu aussi utiliser un index par feuille destination

Private Sub CommandButton3_Click()
Dim don
Dim ligne
Dim j as integer
Dim k As integer
j = 1
k =1
don = 120
For i = 2 To 150
If Cells(i, 9) < don Then
Worksheets(2).Range("A" & i & ":K" & i).Copy
Worksheets(4).Range("A" & j ).PasteSpecial Paste: =xlPasteAll, Operation:= xlNone, SkipBlanks:= _
False, Transpose:=False
j = j +1
Else
Worksheets(2).Range("A" & i & ":K" & i).Copy
Worksheets(3).Range("A" & k).PasteSpecial Paste: =xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
k = k+1
End If
Next i
Worksheets(2).Range("A2").Select
End Sub
Phbil