Dupliquer lignes et incrémenter références

Bonjour,

Je suis novice en macro donc je sollicite votre aide pour ce petit travail

A partir du fichier "Classeur1" le but est d'arriver au résultat de la copie d'écran en pièce jointe (Ne pas tenir compte de la mise en forme).

Je m'explique:

Si pour une référence la quantité et supérieure à 1 alors il faut qu'il y ait autant de lignes (ex: quantité = 3 donc 3 lignes)

Ensuite sur ces lignes identiques il faudrait les incrémenter en suivant le format #001...

Merci pour votre aide

Cordialement

resultat souhaite
8classeur1.xlsm (9.81 Ko)

Bonjour,

A tester :

Sub TraiterRef()
    Dim aa, réf(), n&, i&, j%
    aa = ActiveSheet.Range("A1").CurrentRegion
    n = WorksheetFunction.Sum(WorksheetFunction.Index(aa, 0, 1))
    ReDim réf(n, 1): n = 0
    For i = 2 To UBound(aa)
        If aa(i, 1) = 1 Then
            n = n + 1: réf(n, 0) = 1: réf(n, 1) = aa(i, 2)
        Else
            For j = 1 To aa(i, 1)
                n = n + 1: réf(n, 0) = aa(i, 1)
                réf(n, 1) = aa(i, 2) & " #" & Format(j, "000")
            Next j
        End If
    Next i
    réf(0, 0) = aa(1, 1): réf(0, 1) = aa(1, 2)
    With ActiveSheet.Range("E1").Resize(n + 1, 2)
        .Value = réf
        .Columns.AutoFit
        .HorizontalAlignment = xlCenter
        .Borders.Weight = xlThin
    End With
End Sub

Cordialement.

Bonour,

Merci @MFerrand pour ta réponse cela fonctionne très bien

J'ai une petite question supplémentaire sur ton code:

Si mon fichier ne comporte plus 2 colonnes mais 5 colonnes, comment faire évoluer ton code dans ce sens? Car certains de mes fichiers aurons 5 colonnes.

Merci pour ton aide

capture

Bonjour,

Est-ce que tu dupliques les 3 autres colonnes ?

Oui il faudrait dupliquer les 5 colonnes.

Voilà une version 'générique' qui fonctionnera à partir de 2 colonnes, pour le nombre de colonnes trouvées dans ton tableau.

Le tableau résultat est placé sur une feuille ajoutée à la suite.

Sub TraiterRef_2àXcol()
    Dim aa, réf(), n&, i&, j%, réfer$
    aa = ActiveSheet.Range("A1").CurrentRegion
    n = WorksheetFunction.Sum(WorksheetFunction.Index(aa, 0, 1))
    ReDim réf(n): n = 0
    For i = 2 To UBound(aa)
        If aa(i, 1) = 1 Then
            n = n + 1: réf(n) = WorksheetFunction.Index(aa, i, 0)
        Else
            réfer = aa(i, 2) & " #"
            For j = 1 To aa(i, 1)
                aa(i, 2) = réfer & Format(j, "000")
                n = n + 1: réf(n) = WorksheetFunction.Index(aa, i, 0)
            Next j
        End If
    Next i
    réf(0) = WorksheetFunction.Index(aa, 1, 0)
    With Worksheets.Add(after:=ActiveSheet).Range("A1").Resize(n + 1, UBound(aa, 2))
        .Value = WorksheetFunction.Transpose(WorksheetFunction.Transpose(réf))
        .Columns.AutoFit
        .HorizontalAlignment = xlCenter
        .Borders.Weight = xlThin
    End With
End Sub

Cordialement.

Rechercher des sujets similaires à "dupliquer lignes incrementer references"