XL 2016 Dupliquer x fois le contenu de cellules en fonction de la valeur x contenu dans une autre

thomasdu43

XLDnaute Occasionnel
Bonjour,
J'ai créé un rapport sous excel et souhaite pouvoir dupliquer son contenu tout en conservant sa forme, et ce, autant de fois que la valeur contenue dans une de ses cellules.
Dans l'exemple, la cellule de référence pour dupliquer le rapport est en C13.
En fonction de la valeur en C13, je souhaite que le rapport se multiplie autant de fois soit à partir de la ligne 48, soit à partir de la colonne I, peu importe.
Je vous remercie pour votre aide.
Cordialement.
 

Pièces jointes

  • Test.xlsx
    30 KB · Affichages: 18

job75

XLDnaute Barbatruc
Bonjour thomasdu43,

Cellule C13 ? je suppose qu'il s'agit de H13...

Tel qu'est constitué le rapport il vaut mieux dupliquer horizontalement :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [H13]) Is Nothing Then Exit Sub
Dim n, P As Range, ncol%, i%
n = Val([H13])
Set P = Columns("A:I") 'à adapter
ncol = P.Columns.Count
Application.ScreenUpdating = False
Columns("J").Resize(, Columns.Count - 9).Delete 'RAZ
For i = 1 To n - 1
    P.Copy P.Offset(, i * ncol)
Next
End Sub
La macro se déclenche quand H13 est modifiée.

A+
 

Pièces jointes

  • Test(1).xlsm
    37 KB · Affichages: 10

thomasdu43

XLDnaute Occasionnel
Bonjour thomasdu43,

Cellule C13 ? je suppose qu'il s'agit de H13...

Tel qu'est constitué le rapport il vaut mieux dupliquer horizontalement :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [H13]) Is Nothing Then Exit Sub
Dim n, P As Range, ncol%, i%
n = Val([H13])
Set P = Columns("A:I") 'à adapter
ncol = P.Columns.Count
Application.ScreenUpdating = False
Columns("J").Resize(, Columns.Count - 9).Delete 'RAZ
For i = 1 To n - 1
    P.Copy P.Offset(, i * ncol)
Next
End Sub
La macro se déclenche quand H13 est modifiée.

A+
Bonjour Job75, Merci de votre aide, ça répond totalement à mes attentes.
Bonne soirée
 

ntb

XLDnaute Nouveau
Bonjour thomasdu43,

Cellule C13 ? je suppose qu'il s'agit de H13...

Tel qu'est constitué le rapport il vaut mieux dupliquer horizontalement :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [H13]) Is Nothing Then Exit Sub
Dim n, P As Range, ncol%, i%
n = Val([H13])
Set P = Columns("A:I") 'à adapter
ncol = P.Columns.Count
Application.ScreenUpdating = False
Columns("J").Resize(, Columns.Count - 9).Delete 'RAZ
For i = 1 To n - 1
    P.Copy P.Offset(, i * ncol)
Next
End Sub
La macro se déclenche quand H13 est modifiée.

A+
Bonjour job,

Ta macro est superbe mais comment faut-il faire pour que cela soit non pas copié à côté mais en dessous?

Merci pour ton aide
 

job75

XLDnaute Barbatruc
Bonjour ntb,

Bah il suffit de remplacer les colonnes par des lignes, fichier (2) :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [H13]) Is Nothing Then Exit Sub
Dim n, P As Range, nlig&, i&
n = Val([H13])
Set P = Rows("1:32") 'à adapter
nlig = P.Rows.Count
Application.ScreenUpdating = False
Rows(nlig + 1).Resize(Rows.Count - nlig).Delete 'RAZ
For i = 1 To n - 1
    P.Copy P.Offset(i * nlig)
Next
End Sub
A+
 

Pièces jointes

  • Test(2).xlsm
    35.9 KB · Affichages: 4

ntb

XLDnaute Nouveau
Bonjour ntb,

Bah il suffit de remplacer les colonnes par des lignes, fichier (2) :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [H13]) Is Nothing Then Exit Sub
Dim n, P As Range, nlig&, i&
n = Val([H13])
Set P = Rows("1:32") 'à adapter
nlig = P.Rows.Count
Application.ScreenUpdating = False
Rows(nlig + 1).Resize(Rows.Count - nlig).Delete 'RAZ
For i = 1 To n - 1
    P.Copy P.Offset(i * nlig)
Next
End Sub
A+
Ah oui c'est super ça marche parfaitement ;)

Merci beaucoup et à +
 

ntb

XLDnaute Nouveau
Bonjour ntb,

Bah il suffit de remplacer les colonnes par des lignes, fichier (2) :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [H13]) Is Nothing Then Exit Sub
Dim n, P As Range, nlig&, i&
n = Val([H13])
Set P = Rows("1:32") 'à adapter
nlig = P.Rows.Count
Application.ScreenUpdating = False
Rows(nlig + 1).Resize(Rows.Count - nlig).Delete 'RAZ
For i = 1 To n - 1
    P.Copy P.Offset(i * nlig)
Next
End Sub
A+
Re,

Dernière petite question, comment faut-il faire pour par exemple coller non pas la ligne directement après mais par exemple 5 lignes plus loin?

Merci d'avance :)
 

Discussions similaires

Statistiques des forums

Discussions
311 733
Messages
2 082 019
Membres
101 872
dernier inscrit
Colin T