Discussion :

[bomimi]

Bonjour
Ne maitrisant pas la syntaxe VBA (je balbutie !!), je m'adresse aux utilisateurs de ce forum afin d'avoir de l'aide et mieux comprendre la solution à mon problème.
Au départ un tableau excel avec un nombre de ligne variable. Chaque ligne comporte des cellules renseignées avec des données différentes et l'une d'elle comporte un nombre.
A l'arrivée je souhaite insérer au dessous de chaque ligne l'ensemble des données de celle ci sauf le nombre et l'insérer autant de fois que le nombre l'indique via une macro.
Espérant que ma demande est suffisamment explicite, je vous remercie par avance de votre contribution.

[Philippe Tulliez]

Bonjour,

Espérant que ma demande est suffisamment explicite

Pas assez pour t'aider en tout les cas.

Au départ un tableau excel avec un nombre de ligne variable.

Jusque là pas de problème

Chaque ligne comporte des cellules renseignées avec des données différentes et l'une d'elle comporte un nombre.

Même si ce n'est pas très important pour établir un code, il serait intéressant de savoir le nombre de colonnes mais surtout connaître la position de la colonne de cette fameuse cellule contenant un nombre.

A l'arrivée je souhaite insérer au dessous de chaque ligne l'ensemble des données de celle ci sauf le nombre et l'insérer autant de fois que le nombre l'indique via une macro.

Et là pour moi, c'est la confusion la plus totale.

Une description détaillée des colonnes et peut-être une image si tu ne sais pas l'exprimer de ce que tu as et ce que tu espères obtenir ne serait pas un luxe.

[bomimi]

Je me doutais que mes propos étaient confus !!!

Voici un extrait du tableau :

NOM         PRENOM        IDENTIFIANT    BUREA     NOMBRE
BBBB       NATHALIE          BN          96 89       3
HHHH       LAURENT           HL          52 69       5
MMMM        GERARD           MG          45 87       2

Voici comment je souhaite qu'il soit :

NOM         PRENOM        IDENTIFIANT    BUREAU   NOMBRE
BBBB       NATHALIE          BN          96 89      3
BBBB       NATHALIE          BN          96 89 
BBBB       NATHALIE          BN          96 89 
HHHH       LAURENT           HL          52 69      5
HHHH       LAURENT           HL          52 69 
HHHH       LAURENT           HL          52 69  
HHHH       LAURENT           HL          52 69 
HHHH       LAURENT           HL          52 69 
MMMM       GERARD            MG          45 87      2
MMMM       GERARD            MG          45 87 

Je pense que se sera mieux !!

[casefayere]

Bonjour,

perso, ça me parait clair, juste par curiosité, avant de proposer quelque chose, quel sera l'intérêt de créer tous ces doublons ?

[bomimi]

Le tableau doit servir de base de données entre autre pour la création d'étiquettes en publipostage.

[casefayere]

Même si je pense que d'autres moyens seraient plus rationnels, ci-dessous une idée

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub ESSAI()
Dim Dc As Range
Dim x As Long, y As Integer
With Sheets("Feuil1") 'à remplacer par le nom de feuile réel
  Set Dc = .Range("A" & .Rows.Count).End(xlUp)
  For x = Dc.Row To 2 Step -1
    If .Range("E" & x) > 1 Then
      For y = 2 To .Range("E" & x)
        .Range("A" & x).EntireRow.Insert
        .Range("A" & x + 1, "D" & x + 1).Copy .Range("A" & x)
      Next y
    End If
  Next x
End With
 
End Sub

[bomimi]

Génial !!
Cela correspond tout a fait à ce que je souhaitais obtenir.
Je vais tenter de tout déchiffrer afin de comprendre cela me permettra de progresser.
Merci beaucoup.

[casefayere]

Je vais tenter de tout déchiffrer afin de comprendre cela me permettra de progresser.

ci-dessous, le code expliqué

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub ESSAI()
'donc ci-dessous, déclaration des variables
Dim Dc As Range 'servira à trouver la dernière cellule
Dim x As Long 'je déclare en "Long" pour grand nombre de lignes(>32767)
Dim y As Integer 'ici, je pense que "Integer" suffit amplement
With Sheets("Feuil1") 'à remplacer par le nom de feuille réel
  Set Dc = .Range("A" & .Rows.Count).End(xlUp) 'on va chercher la dernière cellule renseignée
  For x = Dc.Row To 2 Step -1 'on boucle de la dernière ligne à la 2ème, la 1ère étant les titres
    If .Range("E" & x) > 1 Then 'si la cellule en E est supérieure à 1
      For y = 2 To .Range("E" & x) 'on boucle de 2 à la valeur de la cellule en E
        .Range("A" & x).EntireRow.Insert 'on insère une ligne à chaque pas
        .Range("A" & x + 1, "D" & x + 1).Copy .Range("A" & x) 'on copie de A à D à chaque pas
      Next y
    End If
  Next x
End With
'le défaut de cette procédure est que tu retrouves le nombre sur la dernière copie
End Sub

[bomimi]

Vous êtes super gentil.
Merci pour l'explication pas à pas.

[geogeo70]

...A l'arrivée je souhaite insérer au dessous de chaque ligne l'ensemble des données de celle ci sauf le nombre et l'insérer autant de fois que le nombre l'indique via une macro...

bonsoir,

A partir d'une ligne de 4 cellules par exemple, le nombre étant en colonne 4, je vous écris une procédure qui essaye de répondre à votre question :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Sub copie()
 
Dim ws As Worksheet
 
Dim fich As Range, ligne As Range
 
Dim l As Integer, i As Integer
 
Set ws = Worksheets("feuil1")
 
'le fichier...
Set fich = ws.Range(ws.Cells(2, 1), ws.Cells(ws.Range("A2").End(xlDown).Row, 4))
 
'parcours du fichier (ex : le nombre est en col 4)
l = 2
While ws.Cells(l, 1) <> ""  'tant que la ligne n'est pas vide
    If ws.Cells(l, 4).Value > 0 Then
        For i = 1 To ws.Cells(l, 4).Value  'itération de la copie
            Set ligne = ws.Range(ws.Cells(l, 1), ws.Cells(l, 4))
            ligne.Copy
            ws.Cells(l + 1, 1).Insert Shift:=xlDown 'insertion en dessous
            If i = 1 Then ws.Cells(l + 1, 4) = "" 'effacement du nombre (1ere fois)
            Application.CutCopyMode = False
            l = l + 1
        Next i
        Else
            l = l + 1
    End If
    l = l + 1
Wend
 
End Sub

Essayez, ça fonctionne...

geogeo70

re,

Je n'avais pas vu que la discussion était résolue, et je n'avais pas vu votre exemple... mais cela peut être une autre solution.

[casefayere]

Bonjour le forum, bomimi, geogeo70
à Geogeo : ta solution sur le principe est bonne mais quelques corrections s'imposaient, en effet, le tableau de bomimi comporte 5 colones et c'est la 5ème qui prend les itérations, de plus tu copies une fois de trop, ton code corrigé :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Sub copie()
Dim ws As Worksheet
Dim fich As Range, ligne As Range
Dim l As Integer, i As Integer
 
Set ws = Worksheets("feuil1")
'le fichier...
Set fich = ws.Range(ws.Cells(2, 1), ws.Cells(ws.Range("A2").End(xlDown).Row, 5))
'parcours du fichier (ex : le nombre est en col 4)
l = 2
While ws.Cells(l, 1) <> ""  'tant que la ligne n'est pas vide
    If ws.Cells(l, 5).Value > 0 Then
        For i = 1 To ws.Cells(l, 5).Value - 1 'itération de la copie
            Set ligne = ws.Range(ws.Cells(l, 1), ws.Cells(l, 5))
            ligne.Copy
            ws.Cells(l + 1, 1).Insert Shift:=xlDown 'insertion en dessous
            If i = 1 Then ws.Cells(l + 1, 5) = "" 'effacement du nombre (1ere fois)
            Application.CutCopyMode = False
            l = l + 1
        Next i
        Else
            l = l + 1
    End If
    l = l + 1
Wend
 
End Sub

Cela étant dit, comme je l'ai signalé dans mons 2ème post, pour du publipostage, d'autres solutions auraient été plus efficace,

Bonne journée à tou(te)s

[geogeo70]

ok casefayere, j'allais justement adapter au fichier que je n'avais pas vu, on peut aussi supprimer le range fich, je ne m'en suis pas servi...

geogeo70