Doubler les lignes contenant le nombre 1

[serir]

Bonjour ,

Je voulais doubler les lignes contenant 1 dans la colonne nbre,
La difficulté c'est que je n'arrive pas à écrire le nombre de lignes qui serai 16 en vba après la création des doublons.
Le nombre de lignes après la création des doublons n'est pas fixe il est en fonction du nombre de lignes avant la création.

Merci d'avance pour votre aide.

 

[Lone-wolf]

Re : Doubler les lignes contenant le nombre 1

Bonjour serir

Moi pas comprendre ça

le nombre de lignes qui serai 16 en vba après la création

Et ça

Le nombre de lignes après la création des doublons n'est pas fixe

Sinon, en cellule N2 par exemple tu tape le nombre de lignes que tu veux. Ensuite dans la macro

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
nombre = Range("n2")
Target.EntireRow.Resize(rowsize:=nombre).Insert Shift:=xlDown
Cancel = True
End Sub

 

[Dranreb]

Re : Doubler les lignes contenant le nombre 1

Bonjour.

Comme ça :

Sub DoublementLignes()
Dim L As Long
For L = ActiveSheet.Cells(Rows.Count, "D").End(xlUp).Row To 2 Step -1
   If Cells(L, "D").Value = 1 Then
      Rows(L).Copy
      Rows(L).Insert: End If: Next L
End Sub

Moralité: une exécution qui, durant elle même, change le nombre de ligne à traiter doit être entreprise depuis la fin vers le début. Pareil pour des suppressions de lignes.

 

[serir]

Re : Doubler les lignes contenant le nombre 1

Merci beaucoup Dranreb ça fonctionne très bien (seulement dans la ligne dont le code est 0002 il y a la sélection copier c'est à dire des tirés discontinu)

Et merci pour le conseil.

 

[serir]

Re : Doubler les lignes contenant le nombre 1

c'est bon j'ai rajouté Application.CutCopyMode = False pour enlever la sélection copirer.

 

[Lone-wolf]

Re : Doubler les lignes contenant le nombre 1

Bonjour Dranreb

 

[Lone-wolf]

Re : Doubler les lignes contenant le nombre 1

Re à tous

Un autre exemple

Sub DoublementLignes()
Dim lig, col, nb As Long
Dim cel As Range
Sheets("Feuil8").Activate
With ActiveSheet
For Each cel In .Range("d2:d1002")
If cel Like "*1" Then
nb = .Range("f1")  ' nombre de lignes à inserer
cel.Offset(1, 3).EntireRow.Resize(rowsize:=nb).Insert Shift:=xlDown
End If
Next cel
For lig = 2 To .Range("a65536").End(xlUp).Row
For col = 1 To 4
If .Cells(lig, col) = "" Then
.Cells(lig, col) = .Cells(lig - 1, col)
End If
Next col
Next lig
End With
End Sub

 

[Dranreb]

Re : Doubler les lignes contenant le nombre 1

Bonjour Lone-wolf