Macro: quantité = nbr de ligne

Bonjour à tous,

Après plusieurs recherche infructueuse sur ce forum, je me décide à exposer mon problème.

J'ai un tableau contenant des repères avec des quantités. Je souhaiterais créer automatiquement un second tableau, sur une autre feuille.

Sur ce second tableau, je voudrais que les quantités correspondent au nombre de ligne.

Le premier tableau peut contenir des centaines d'entrées, et les quantités ne sont jamais identique.

Je suppose qu'une macro peut faire ce travail. Mais malheureusement je n'ai pratiquement aucune connaissance dans les macros.

Pour être plus clair je joins un fichier.

Je vous remercie par avance.

ATHEX49

Bonjour,

Essaie avec ce code :

Sub test()
'Macro Dan pour ATHEX49 le 28/06/2010 -  XL Pratique
Dim i As Long
For i = 2 To Range("A65536").End(xlUp).Row
Do While Range("C" & i) <> 0
Range("A" & i & ":B" & i).Copy Sheets("Feuil2") _
.Range("A" & Sheets("Feuil2").Range("A65536").End(xlUp).Row + 1)
 Range("C" & i) = Range("C" & i) - 1
Loop
Next
End Sub

Si ok n'oublie pas de cloturer le fil en cliquant sur le V de couleur Vert à coté du bouton Editer

Amicalement

Bonjour,

Re-, Dan

une autre solution :

Sub eclate()
Dim NbLig As Byte
Dim Fs As Worksheet, Fd As Worksheet
Set Fs = Sheets("Feuil1")
Set Fd = Sheets("Feuil2")
Application.ScreenUpdating = False
Fd.Cells.Clear
With Fs
    .Range("A1:C" & .[A65000].End(xlUp).Row).Copy Fd.Range("A1")
End With
With Fd
    For i = .[A65000].End(xlUp).Row To 2 Step -1
        NbLig = .Cells(i, 1).Offset(0, 2) - 1
        If NbLig > 0 Then
            .Rows(i + 1).Resize(NbLig).Insert
            .Cells(i, 1).Resize(1, 2).AutoFill Destination:=.Cells(i, 1).Resize(NbLig + 1, 2)
        End If
    Next i
    .Columns(3).Delete
End With
End Sub

Au choix...

Bonne journée

Re boujour

C'est exactement ce que je voulais

J'ai essayer les deux.

Seul bémol sur la solution de DAN. après exécution de la macro les quantités du premier tableau deviennent toutes des zéro.

Enfin Je vous remercie pour ces réponse ULTRA RAPIDE

ATHEX49

re,

lol ! j'ai corrigé le code directement sur le forum sans vérifier. Comme quoi ...

Code corrigé :

Sub test()
'Macro Dan pour ATHEX49 le 28/06/2010 -  XL Pratique
Dim i As Long
Dim nb
For i = 2 To Range("A65536").End(xlUp).Row
nb = Range("C" & i)
Do While nb <> 0
Range("A" & i & ":B" & i).Copy Sheets("Feuil2") _
.Range("A" & Sheets("Feuil2").Range("A65536").End(xlUp).Row + 1)
 nb = nb - 1
Loop
Next
End Sub

Encore désolé.

Amicalement