Split en plusieurs lignes

Bonjour à tous,

Je possède un fichier avec 2 colonnes.

• colonne A : code EAN d'articles commercialisés (code unique)
• colonne B : quantité en stock

Je souhaiterais pouvoir splitter les quantités en nombre de lignes correspondantes. C'est-à-dire que si la quantité est de 3, je dois avoir 3 lignes qui se génèrent avec la quantité 1. Si j'ai 16 en quantités, 16 lignes doivent se générer avec une quantité 1.

D'avance, merci pour votre aide précieuse !

Bonjour

un fichier test serait necessaire pour aider

Fred

un fichier test serait necessaire pour aider

Voici

Bonjour,

j'ai déjà eu ce problème une fois

Sub duplication()
Dim fin As Long
Dim code As Variant
Dim nbre As Long

fin = WorksheetFunction.Sum(Range("B1:B" & Range("B65536").End(xlUp).Row))
For i = 1 To fin
        code = Range("A" & i).Value
        nbre = Range("B" & i).Value
    If nbre > 1 Then
        Rows(i + 1).Select
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Range("B" & i) = 1
        Range("A" & i + 1) = code
    Range("B" & i + 1) = nbre - 1
    End If
Next i
End Sub

Ca fonctionne évidemment à merveille. Merci !

Ceci dit, je pensais pouvoir adapter le fichier avec ma troisième colonne, mais étant nul en macro, je n'y parviens pas. Pouvez-vous m'adapter le macro au fichier joint ?

Promis, après je m'en sortirai !

il suffit de décaler d'une colonne :

Sub duplication()
Dim fin As Long
Dim EAN As Variant, titre as variant 
Dim nbre As Long

fin = WorksheetFunction.Sum(Range("C2:C" & Range("B65536").End(xlUp).Row))
For i = 1 To fin
        EAN  = Range("A" & i).Value
        titre = Range("B" & i).Value
        nbre = Range("C" & i).Value
    If nbre > 1 Then
        Rows(i + 1).Select
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Range("C" & i) = 1
        Range("A" & i + 1) = EAN
        Range("B" & i + 1) = titre
        Range("C" & i + 1) = nbre - 1
    End If
Next i
End Sub

Super, grand merci !!!

Bonjour, bonjour !

En respectant la hiérarchie objet d'Excel, voici une démonstration efficace :

Sub Demo()
Application.ScreenUpdating = False

With Feuil1
    For R& = .Cells(1).CurrentRegion.Rows.Count To 2 Step -1
        If .Cells(R, 1).Value <> .Cells(R - 1, 1).Value And .Cells(R, 3).Value > 1 Then
           .Rows(R + 1).Resize(.Cells(R, 3).Value - 1).Insert xlShiftDown
           .Rows(R).Copy .Rows(R + 1).Resize(.Cells(R, 3).Value - 1)
           .Cells(R, 3).Resize(.Cells(R, 3).Value).Value = 1
        End If
    Next
End With
End Sub

Grand merci pour la célérité de vos réponses