Macro pour extraction de ligne

Bonjour à tous,

Étant novice sur VBA je me retourne vers vous pour un petit coup de main.

Je cherche une macro (à exécuter avec un bouton) pour extraire des lignes en feuille 2 sous condition.

Si dans la colonne D une des cellules est différente de 0 (exemple 1 ,8 ,10 , 42 ....) je copie toute la ligne de la feuille 1 en feuille 2

Mes lignes d’écriture ne commencent qu'à partir de la ligne 10

j’espère avoir été assez clair, je vous ai joint mon ficher pour que ce soit plus concret .

Merci d'avance de votre aide

Bonne journée

Bonjour Becbec, bonJour le forum,

Peut-être comme ça :

Sub Macro1()
Dim S As Worksheet 'déclare la variable S (onglet Source)
Dim D As Worksheet 'déclare la variable D (onglet Destination)
Dim TC As Variant 'déclare la variable TC (Tableau de Cellules)
Dim TL() As Variant 'déclare la variable TL (Tableau de Lignes)
Dim K As Integer 'déclare la variable K (incrément)
Dim I As Integer 'déclare la variable I (Incrément)

Set S = Sheets("Feuil1") 'définit l'onglet S
Set D = Sheets("Feuil2") 'définit l'onglet D
TC = S.Range("A9").CurrentRegion 'définit le tableau de cellules TC
K = 1 'initialise la variable K
For I = 2 To UBound(TC, 1) 'boucle sur toutes les lignes du tableau de cellules TC (en partant de la seconde)
    If TC(I, 4) > 0 Then 'condition : si la valeur ligne I , colonne 4 de TC est supérieure a 0
        ReDim Preserve TL(1 To 3, 1 To K) 'redimensionne le tableau de lignes TL
        'transpose les données de la ligne en colonne
        TL(1, K) = TC(I, 2) 'récupère la désignation
        TL(2, K) = TC(I, 3) 'récupère la référence
        TL(3, K) = TC(I, 4) 'récupère la quantité
        K = K + 1 'incrémente K
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle
'renvoie dans la cellule B1 de l'onglet destination le tableau TL transposé
If K > 1 Then D.Range("B1").Resize(UBound(TL, 2), UBound(TL, 1)) = Application.Transpose(TL)
End Sub

Bonjour ThauThème

Tout d’abord merci de ta réponse

Ton code fonctionne très bien, mais j'aurais voulu qu’il copie toute la ligne dans le cas ou j'ai des prix d'inscrit et aussi d'autre annotations dans les cellules plus loin .

Et comment faire pour que les lignes copier sur la feuille 2 se positionne en A10 par exemple ?

Merci d'avance !

Re,

Comme tu utilises des cellules fusionnées en colonne A cela complique la copie de cette colonne. Le code modifié :

Sub Macro1()
Dim S As Worksheet 'déclare la variable S (onglet Source)
Dim D As Worksheet 'déclare la variable D (onglet Destination)
Dim TC As Variant 'déclare la variable TC (Tableau de Cellules)
Dim TL() As Variant 'déclare la variable TL (Tableau de Lignes)
Dim K As Integer 'déclare la variable K (incrément)
Dim I As Integer 'déclare la variable I (Incrément)

Set S = Sheets("Feuil1") 'définit l'onglet S
Set D = Sheets("Feuil2") 'définit l'onglet D
TC = S.Range("A9").CurrentRegion 'définit le tableau de cellules TC
K = 1 'initialise la variable K
For I = 2 To UBound(TC, 1) 'boucle sur toutes les lignes du tableau de cellules TC (en partant de la seconde)
   If TC(I, 4) > 0 Then 'condition : si la valeur ligne I , colonne 4 de TC est supérieure a 0
       ReDim Preserve TL(1 To 5, 1 To K) 'redimensionne le tableau de lignes TL
       'transpose les données de la ligne en colonne
       TL(1, K) = TC(I, 2) 'récupère la désignation
       TL(2, K) = TC(I, 3) 'récupère la référence
       TL(3, K) = TC(I, 4) 'récupère la quantité
       TL(4, K) = TC(I, 5) 'récupère le prix unitaire
       TL(5, K) = TC(I, 6) 'récupère le prix total
       K = K + 1 'incrémente K
   End If 'fin de la condition
Next I 'prochaine ligne de la boucle
'renvoie dans la cellule B1 de l'onglet destination le tableau TL transposé
If K > 1 Then D.Range("B10").Resize(UBound(TL, 2), UBound(TL, 1)) = Application.Transpose(TL)
End Sub

Super merci beaucoup !!!!

A bientôt.