Duplication de la ligne crée selon le nombre saisie à la fin de cette ligne

[wifithesniper]

Bonjour,

Je souhaite savoir si il est possible de dupliquer la ligne saisie selon un nombre que l'on saisi dans un champ à la fin de cette ligne.
Exemple si je saisi 17 il duplique 16 ligne supplementaire et il me remplace le nombre 17 de mes 17 lignes par 1.
Merci pour votre aide.

Cdlt,

 

[job75]

Re : Duplication de la ligne crée selon le nombre saisie à la fin de cette ligne

Bonjour wifithesniper,

Voyez le fichier joint avec cette macro :

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [F2:F65536]) Is Nothing Or Target.Count > 1 Then Exit Sub
If Target = "" Or Not IsNumeric(Target) Then Exit Sub
Dim n As Long, lig As Long, plage As Range
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les événements
On Error Resume Next 'sécurité
n = Target - 1
lig = Target.Row
Set plage = Rows(lig)
Cells(lig, 6) = 1
For n = 1 To n
  Rows(lig).Insert
Next
plage.Copy plage.Offset(1 - n).Resize(n)
Application.EnableEvents = True
End Sub

A+

 

[wifithesniper]

Re : Duplication de la ligne crée selon le nombre saisie à la fin de cette ligne

Bonsoir job75,

Je vais essayer de tester ce week-end et je tiens au courant.
Merci.

Cdlt,

 

[job75]

Re : Duplication de la ligne crée selon le nombre saisie à la fin de cette ligne

Bonjour wifithesniper, le forum,

Voici une solution nettement meilleure, surtout s'il faut insérer beaucoup de lignes.

Elle utilise le Couper-Coller :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim plage As Range, n As Long, lig As Long, derlig As Long
Set plage = Range("F2:F" & Rows.Count) 'à adapter
If Intersect(Target, plage) Is Nothing Or Target.Count > 1 Then Exit Sub
If Target = "" Or Not IsNumeric(Target) Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les événements
On Error Resume Next
n = Application.Max(Target - 1, 0) 'si valeur < 0
lig = Target.Row
Cells(lig, plage.Column) = 1
derlig = Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
Rows(lig & ":" & derlig).Cut Cells(lig + n, 1) 'Couper-Coller
If Err Then MsgBox "Insertion de " & n & " lignes impossible, des données sortiraient de la feuille !", 48 _
Else Rows(lig + n).Copy Rows(lig).Resize(n)
Application.EnableEvents = True
End Sub

Fichier (2).

Edit : j'avais écrit ceci mais curieusement il y a parfois un problème :

Rows(lig & ":" & derlig).Cut Rows(lig + n)

Et en effet, en faisant des essais de collage sur une ligne entière, on arrive à obtenir ce message :

Les zones de copie et de collage ne peuvent se superposer que si elles sont de dimension et de forme identiques.

A+

 

[wifithesniper]

Re : Duplication de la ligne crée selon le nombre saisie à la fin de cette ligne

Salut,

C'est nickel , mais je souhaite rajouter de la mise en page avec ce code :

With Selection.Font
.Name = "Arial"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Selection.Font.Bold = True
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65280
.TintAndShade = 0
.PatternTintAndShade = 0
End With

Ma question: comment l'appliquer à toutes les nouvelles lignes crées ???

Cdlt,

 

[job75]

Re : Duplication de la ligne crée selon le nombre saisie à la fin de cette ligne

Bonjour wifithesniper,

Votre code ne fonctionne que sur Excel2007/2010, alors fichier .xlsm(3) avec ce code :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim plage As Range, n As Long, lig As Long, derlig As Long
Set plage = Range("F2:F" & Rows.Count) 'à adapter
If Intersect(Target, plage) Is Nothing Or Target.Count > 1 Then Exit Sub
If Target = "" Or Not IsNumeric(Target) Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les événements
On Error Resume Next
n = Application.Max(Target - 1, 0) 'si valeur < 0
lig = Target.Row
Cells(lig, plage.Column) = 1
derlig = Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
Rows(lig & ":" & derlig).Cut Cells(lig + n, 1) 'Couper-Coller
If Err Then
  MsgBox "Insertion de " & n & " lignes impossible, des données sortiraient de la feuille !", 48
Else
  Rows(lig + n).Copy Rows(lig).Resize(n)
  With Rows(lig).Resize(n + 1, plage.Column) 'plage à mettre en forme
    With .Font
      .Name = "Arial"
      .Size = 12
      .Strikethrough = False
      .Superscript = False
      .Subscript = False
      .OutlineFont = False
      .Shadow = False
      .Underline = xlUnderlineStyleNone
      .ColorIndex = xlAutomatic
      .TintAndShade = 0
      .ThemeFont = xlThemeFontNone
    End With
    .Font.Bold = True
    With .Interior
      .Pattern = xlSolid
      .PatternColorIndex = xlAutomatic
      .Color = 65280
      .TintAndShade = 0
      .PatternTintAndShade = 0
    End With
  End With
End If
Application.EnableEvents = True
End Sub

Cela dit pourquoi ne pas mettre en forme manuellement la (les) ligne(s) à dupliquer, une fois pour toutes ?

A+

 

[wifithesniper]

Re : Duplication de la ligne crée selon le nombre saisie à la fin de cette ligne

Re,

C'est possible d'appliquer la mise en page juste sur la case qui contient le chiffre , colonne F dans ton exemple ???

Cdlt,

 

[job75]

Re : Duplication de la ligne crée selon le nombre saisie à la fin de cette ligne

Re,

With Cells(lig, plage.Column).Resize(n + 1) 'plage à mettre en forme

Fichier (3bis). Et merci de répondre à ceci :

Cela dit pourquoi ne pas mettre en forme manuellement la (les) ligne(s) à dupliquer, une fois pour toutes ?

A+

 

[job75]

Re : Duplication de la ligne crée selon le nombre saisie à la fin de cette ligne

Re,

Plutôt qu'un code de 23 lignes une petite MFC (en colonne F) ne ferait pas aussi bien l'affaire ???

A+

 

[wifithesniper]

Re : Duplication de la ligne crée selon le nombre saisie à la fin de cette ligne

Re,

"Cela dit pourquoi ne pas mettre en forme manuellement la (les) ligne(s) à dupliquer, une fois pour toutes ?"

Tu veux dire quoi par manuellement ???

Cdlt,

 

[job75]

Re : Duplication de la ligne crée selon le nombre saisie à la fin de cette ligne

Re,

Tu veux dire quoi par manuellement ???

Euphémisme bien sûr, c'est avec la papatte de la souris... Quand on crée la feuille

A+

 

[wifithesniper]

Re : Duplication de la ligne crée selon le nombre saisie à la fin de cette ligne

Re,

Finalement la MFC est nickel , donc j'ai récuperer ton code pour la duplication et la MFC pour la mise en forme.
Merci de ton aide.

Cdlt,