Copier/Coller lignes sous conditions dans Excell

Question

Bonjour,

Voi&#231;i un petit code qui permet via un bouton de trier les donn&#233;es d'un tableau et de les dispatcher dans deux autre feuilles.

Sachent que la premi&#232;re ligne est pour les titres des collones, on commence &#224; la seconde ligne.  La variable "don" est ma condition.  Je n'annalyse que les 150 premi&#232;re lignes du tableau.  Si les valleur dans les case de la 9 &#232;me colonne sont < &#224; ma variable don, je copie la ligne et la colle dans une feuile, m&#234;me chose si la valleur est > &#224; la variable.

Il y a moyen de faire un tri automatique &#224; la fin de la comparaisonce qui aura pour effet de rassembler toutes les donn&#233;es vers le haut de la feuille et pas dic&#233;min&#233;e dans tout le tableau.

Voil&#224;.

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

cs_phBil · Answer

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

Copier/Coller lignes sous conditions dans Excell

1 réponse

Discussions similaires