Macro pour multiplier lignes

[hasardeux]

Bonsoir le forum,

J'aimerais que vous m'aidiez à résoudre un problème sous excel.

En effet, j'ai un classeur excel comportant 4 colonnes :

N° Facture
Date
HT
TTC
TVA

Je voudrais que chaque ligne soit dupliqué en 3 lignes afin de distinguer le TTC, HT et TVA, pas en colonnes mais en lignes.

Le résultat doit être de ce format (en rajoutant une nouvelle colonne COMPTE):

N° Facture
Date
Montant
Compte

==> avec Ligne 1 montant HT (avec valeur de COMPTE : 70400000)
==> et avec Ligne 2 montant TTC (avec valeur de COMPTE : 41100000)
==> et avec Ligne 3 montant TVA (avec valeur de COMPTE : 44573000)

Ci-joint un classeur démonstratif.

Merci pour aide préciseuse

 

[JBARBE]

Re : Macro pour multiplier lignes

Bonsoir,

Peut-être ceci ! il y a des doublons que l'on peut enlever mais le résultat est là !

bonne soirée

 

[mapomme]

Re : Macro pour multiplier lignes

Bonjour hasardeux, Jbarbe,

Bon, j'ai encore mal lu la question et je l'ai fait par formules et non par macro (on s'y remet). Je joins malgré tout le fichier puisqu'il est fait!

 

[hasardeux]

Re : Macro pour multiplier lignes

Merci pour la réponse rapide.

Est-ce qu'il est possible d'avoir une macro. Car mon fichier réel comporte des milliers de lignes.

Cordialement

 

[mapomme]

Re : Macro pour multiplier lignes

Re,

J'ai dit que je m'y remettais, je l'ai fait. Voici un essai en macro.

En fonction du nombre initial de lignes et de la quantité de mémoire de mémoire disponible, il se peut que le programme coince (à cause de la taille du tableau xinit). Dans ce cas, revenir ici pour demander une autre version.

Le code dans module1:

Sub PlusDeLignes()
Dim xinit, xcompte, xrg As Range, i&, j&

Application.ScreenUpdating = False
With Sheets("Initial")
  xinit = .Range(.Range("a2"), .Range("e" & .Range("a" & Rows.Count).End(xlUp).Row)).Value
  xcompte = .Range(.Range("g2"), .Range("g" & .Range("g" & Rows.Count).End(xlUp).Row)).Value
End With

With Sheets("Attendu")
  Set xrg = .Range("a2")
  .Range("a2:d" & Rows.Count).Clear
  .Range("h2:j" & Rows.Count).Clear
  For i = LBound(xinit) To UBound(xinit)
    xrg.Resize(3) = xinit(i, 1)
    xrg.Offset(, 1).Resize(3) = xinit(i, 2)
    For j = 0 To 2
      xrg.Offset(j, 2) = xcompte(j + 1, 1)
      xrg.Offset(j, 3) = xinit(i, j + 3)
    Next j
    For j = 0 To 2
      xrg.Offset(, j + 7) = xinit(i, j + 3)
    Next j
    Set xrg = xrg.Offset(3)
  Next i
  .Range("a1").CurrentRegion.Borders.LineStyle = xlContinuous
  .Range("a1").CurrentRegion.Offset(, 7).Resize(, 3).Borders.LineStyle = xlContinuous
  For i = 5 To .Range("a1").CurrentRegion.Rows.Count Step 6
    .Range("a" & i).Resize(3, 4).Font.Bold = True
    .Range("a" & i).Offset(, 7).Resize(3, 3).Font.Bold = True
  Next i
  Application.Goto .Range("a1"), True
End With
Application.ScreenUpdating = True
End Sub

 

[hasardeux]

Re : Macro pour multiplier lignes

Franchement c'est top.

Exactement ce que je voulais, voire plus avec le gras en cerise

Merci beaucoup