Copier ligne sous condition

Bonsoir,

J'ai besoin d'un coup de main concernant le fichier ci-joint svp.

Dans l'onglet "Réceptions", comme son nom l'indique je saisie des réceptions de pièces. Ce sont des box de 9000 pcs + des mécomptes.

Je voudrais coller ces cellules via une macro dans l'onglet "Stock" sur la ligne correspondante à ma référence produit et à la suite des quantités déjà enregistrées.

Pourriez-vous m'aider svp ?

Je suis désolée si je ne suis pas très réactive lors de votre réponse, mais je suis dans le trou du cul du monde et le réseau est nul !

Bonne soirée

Sandrine

Bonjour

Ci joint ma solution

A+ François

Bonjour,

Autre proposition (si j'ai bien compris):

Cdlt

Bonjour à tous,
Et une petite 3e

Bonjour à tous,

Je profite d'une connexion réseau pour vous remercier de votre aide et votre patience.

La version de Optimix fonctionne à peu près, sauf qu'a chaque insertion j'ai un message me disant que la référence n'existe pas.

La version d'Arturo83 fonctionne pour la référence 1 mais ensuite tout est décalé

Quant à la version de Fanfan38, le transfert additionne les quantités.

Je vous remercie encore.

Sandrine

Bonjour,

Effectivement une petite erreur s'est glissée dans une ligne

voici le correctif

Sub Recup_Donnees()
    Dim f1 As Worksheet, f2 As Worksheet
    Dim i As Long, DerLig_f1 As Long, DerLig_f2 As Long
    Dim x As Long, DerCol_f1 As Long, DerCol_f2 As Long, Nb_Valeurs As Long
    Dim Ref_f1

    Application.ScreenUpdating = False
    RecuperationDonnees = True
    Set f1 = Sheets("Réceptions")
    Set f2 = Sheets("Stock")
    DerLig_f1 = f1.Range("A" & Rows.Count).End(xlUp).Row
    DerLig_f2 = f2.Range("A" & Rows.Count).End(xlUp).Row

    For i = 2 To DerLig_f1
        Ref_f1 = f1.Cells(i, "C")
        Nb_Valeurs = f1.Cells(i, "E")
        DerCol_f1 = Nb_Valeurs + 5
        If DerCol_f1 > 6 Then
            On Error Resume Next
            x = Application.Match(Ref_f1, f2.Range(f2.Cells(1, "A"), f2.Cells(DerLig_f2, "A")), 0)
            If Err.Number = 0 Then
                DerCol_f2 = f2.Cells(i, "R").End(xlToLeft).Column
                Range(f2.Cells(x, DerCol_f2 + 1), f2.Cells(x, DerCol_f2 + Nb_Valeurs)).Value = Range(f1.Cells(i, "F"), f1.Cells(i, DerCol_f1)).Value
            End If
            On Error GoTo 0
        End If
    Next i
    RecuperationDonnees = False

    Set f1 = Nothing
    Set f2 = Nothing
End Sub

l'erreur est ici

DerCol_f2 = f2.Cells(2, "R").End(xlToLeft).Column

il fallait remplacer le 2 par i

Cdlt

Bonjour,

D'accord merci je vais essayer.

Bonne journée

Sandrine