Modify a line into several lines

Hi everyone,


I'm currently developing an excel file to import data into an Access database which will manage the fixed asset of my company.

My problem is the following: so I have an excel file which gathering all invoices of every fixed asset. In my database, each F/A has it's own TAG and must have it's own invoice.
The problem occur when in one invoice we found several assets.

What i'm trying to do is when the quantity is over 1, excel must duplicate the line and modify the quantity. For example if at the beginning the quantity is 3 at the and I have 3 line with quantity 1.
Furthermore, as I said before each F/A has is own TAG. After excel made a line for each F/A I would like to redistribute the TAGs.
On the original line if their is several items the TAG are separated by a coma. And if an item doesn't have a TAG the default value will be Spare

I enclose a sample of what I would like. The first sheet is the original file and the second sheet is the target.

Thanks every for your help

Merci à tous pour votre aide

Hi julien4266

Sample files don't appear to be attached.

John

Hi julien4266

I'll look at this tonight.

John

Hi julien4266

It appears there's a problem with line 10 of your original data. You have a Qte of 5 but a TAG of only 4. I'm going to assume the extra item is a Spare but it shouldn't matter. However, these must match or you'll get incorrect data.

I may post an offered solution soon.

John

Hi julien4266

This code is included in the attached workbook (your sample data).

Option Explicit
Public Sub Test()
    Dim rng As Range
    Dim LR As Long
    Dim i As Integer
    Application.ScreenUpdating = False
    LR = Range("A" & Rows.Count).End(xlUp).Row
    Set rng = Range("E2:E" & LR)
    With rng
        For i = LR To 1 Step -1
            If rng(i).Value > 1 Then
                rng(i).Offset(1, 0).Resize(rng(i).Value - 1, 1).EntireRow.Insert
                rng(i).Offset(0, 0).EntireRow.Copy
                rng(i).Offset(1, -4).Resize(rng(i).Value - 1, 1).PasteSpecial
            End If
        Next
    End With
 
    Call Test1
 
    Application.ScreenUpdating = True
End Sub
Sub Test1()
    Dim Arr As Variant
    Dim i As Integer
    Dim rng As Range
    Dim fCell As Range
    Dim LR As Long: LR = Range("K" & Rows.Count).End(xlUp).Row
    Set rng = Range("K2:K" & LR)
    With rng
        For Each fCell In rng
            If fCell.Offset(1, -1) <> fCell.Offset(0, -1) Then GoTo Skip
            Arr = Split(fCell.Value, ",")
            For i = LBound(Arr) To UBound(Arr)
                fCell.Offset(i, 0) = LTrim(Arr(i))
            Next i
Skip:
        Next fCell
    End With
End Sub

It appears to do what you requested. Let me know of issues.

John