Transfere

Bonjours a tous et toutes

Permettez-moi d’abord de vous remercier pour toutes laide que vous m'apportez

Car sans vous je serais dans la panade lol

Là j’ai un autre petit problème je voudrai recopier certaine cellules d’une feuille dans un autre feuil

Ceci n’est pas trop complique mais ce qui se complique c que je voudrais les recopier sous condition

Voila dans une feuille j’ai des ref produit avec des libellés et des quantités

Et j’aimerai transférer dans la fauil2 que si les quantités et > a 0 et ceci automatiquement

Je join un petit model pour ex

Merci d’avance et à bientôt

7classeur5.xlsx (9.38 Ko)

Salut,

Je n'ai pas excel 2007, il me met une erreur lors de la conversion (pour enregistrer)

Par contre, si tu ouvres ton fichiers, tu te positionne sur la feuil1 et tu appuies sur ALT F11 pour ouvrir editeur VBA, puis dans le code de la feuil1 tu copie le code suivant :

(Private Sub Worksheet_Change veut dire que si tu change une valeur dans cette feuille la macro s'execute.)

Dis moi si cela te convient.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim W_myworksheet As Worksheet
Set W_myworksheet = ActiveWorkbook.Worksheets("Feuil2")

Dim L_myworksheet As Worksheet
Set L_myworksheet = ActiveWorkbook.Worksheets("Feuil1")
Dim c As Range
Dim i As Double
Dim n As Double
n = 2

'Si 'Lib' n'est pas vide ET 'Ref Prod' n'est pas vide et que l'on a modifié une quantité
If Target.Column = 3 And Cells(Target.Row, Target.Column - 1).Value <> "" And Cells(Target.Row, Target.Column - 2).Value <> "" Then

    'On supprime tout les enregistrement : dans le cas où on aurait remis un quantité a zéro, il faut l'enlever de la feuille2...
    W_myworksheet.Range("A2", "C250").Clear  'Je supprime tout jusqua la ligne 250

    'On recopie les valeurs de la feuill1 vers la Feuill2 pour les quantité>0
        'Récupère le numéro de la dernière ligne non vide
    ligne = L_myworksheet.Columns(1).SpecialCells(xlCellTypeLastCell).Row

    'Boucle sur les cellules     For i = 2 To ligne

        If L_myworksheet.Cells(i, 3) > 0 And L_myworksheet.Cells(Target.Row, Target.Column - 1).Value <> "" And L_myworksheet.Cells(Target.Row, Target.Column - 2).Value <> "" Then
             W_myworksheet.Cells(n, 1) = L_myworksheet.Cells(i, 1)
             W_myworksheet.Cells(n, 2) = L_myworksheet.Cells(i, 2)
             W_myworksheet.Cells(n, 3) = L_myworksheet.Cells(i, 3)
             n = n + 1

        End If

    Next
End If
End Sub
Rechercher des sujets similaires à "transfere"