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

[thomasdu43]

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.

 

[job75]

Bonjour thomasdu43,

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

Tel qu'est constitué le rapport il vaut mieux dupliquer horizontalement :

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+

 

[sousou]

Bonjour
Quelque chose comme ceci
Sub deb()
der = Cells(ActiveSheet.UsedRange.Rows.Count + 1, 1).End(xlUp).Row
For n = 1 To Range("c13")
Range(Cells(1, 1), Cells(der + 1, 10)).Copy Cells(1, (10 * n) + 1)
Next
End Sub

 

[job75]

Bonjour sousou,

En copie horizontale il faut copier les largeurs des colonnes...

En copie verticale il faut copier les hauteurs des lignes...

A+

 

[thomasdu43]

Bonjour thomasdu43,

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

Tel qu'est constitué le rapport il vaut mieux dupliquer horizontalement :

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]

Bonjour thomasdu43,

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

Tel qu'est constitué le rapport il vaut mieux dupliquer horizontalement :

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]

Bonjour ntb,

Bah il suffit de remplacer les colonnes par des lignes, fichier (2) :

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+

 

[ntb]

Bonjour ntb,

Bah il suffit de remplacer les colonnes par des lignes, fichier (2) :

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]

Bonjour ntb,

Bah il suffit de remplacer les colonnes par des lignes, fichier (2) :

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

 

[job75]

For i = 1 To n - 1
    P.Copy P.Offset(i * (nlig + 5))
Next

 

[ntb]

For i = 1 To n - 1
    P.Copy P.Offset(i * (nlig + 5))
Next

Super merci beaucoup