Bonjour
Dans un tableau excel 2010, j'ai en A, B, C :
1889 40 R 42 500
1889 40 R 43 445
1890 40 R 45 500
1890 40 R 46 295
1891 40 R 48 500
etc...
Je souhaite ins=C3=A9rer autant de lignes que le chiffre de la colonne C -1
ex sous 1889 40 R 42 il me faudrait 499 lignes, sous 40 R 43 il faudrait 4=
44 lignes, etc...
Un moyen d'automatiser la chose ?
Merci
Cordialement
J'avais trouv=C3=A9 une macro qui permet de la faire en saisissant le nombr=
e de ligne, mais c'est insertion par insertion...long...
Sub insererlignes()
Dim a As Integer
Dim b As Long
b =3D ActiveCell.Row
a =3D Application.InputBox(prompt:=3D"Nombre de lignes =C3=A0 ajouter:", Ty=
pe:=3D1)
If a =3D 0 Then
Exit Sub
End If
ActiveSheet.Range("A" & b, "A" & b + a - 1).EntireRow.Insert
End Sub
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Michd
Bonjour, Essaie comme ceci. N'oublie pas d'adapter le nom de la feuille. '--------------------------------------------------------- Sub test() Dim N As Long, Rg As Range Dim AddRow As Long, A As Long Dim X As Long With Worksheets("Feuil13") 'nom à adapter 'définir la plage de cellules (sans ligne vide) Set Rg = .Range("C1:C" & .Range("C" & .Rows.Count).End(xlUp).Row) 'Le nombre total de lignes à ajouter AddRow = Application.Sum(Rg) 'Lignes ajoutées + lignes déjà existantes N = AddRow + Rg.Rows.Count 'Je suppose que le tableau début en ligne 1, à adapter au besoin. For A = 1 To N X = .Range("C" & A).Value .Range("A" & A).Offset(1).Resize(X).EntireRow.Insert A = A + X Next End With End Sub '--------------------------------------------------------- MichD
Bonjour,
Essaie comme ceci. N'oublie pas d'adapter le nom de la feuille.
'---------------------------------------------------------
Sub test()
Dim N As Long, Rg As Range
Dim AddRow As Long, A As Long
Dim X As Long
With Worksheets("Feuil13") 'nom à adapter
'définir la plage de cellules (sans ligne vide)
Set Rg = .Range("C1:C" & .Range("C" & .Rows.Count).End(xlUp).Row)
'Le nombre total de lignes à ajouter
AddRow = Application.Sum(Rg)
'Lignes ajoutées + lignes déjà existantes
N = AddRow + Rg.Rows.Count
'Je suppose que le tableau début en ligne 1, à adapter au besoin.
For A = 1 To N
X = .Range("C" & A).Value
.Range("A" & A).Offset(1).Resize(X).EntireRow.Insert
A = A + X
Next
End With
End Sub
'---------------------------------------------------------
Bonjour, Essaie comme ceci. N'oublie pas d'adapter le nom de la feuille. '--------------------------------------------------------- Sub test() Dim N As Long, Rg As Range Dim AddRow As Long, A As Long Dim X As Long With Worksheets("Feuil13") 'nom à adapter 'définir la plage de cellules (sans ligne vide) Set Rg = .Range("C1:C" & .Range("C" & .Rows.Count).End(xlUp).Row) 'Le nombre total de lignes à ajouter AddRow = Application.Sum(Rg) 'Lignes ajoutées + lignes déjà existantes N = AddRow + Rg.Rows.Count 'Je suppose que le tableau début en ligne 1, à adapter au besoin. For A = 1 To N X = .Range("C" & A).Value .Range("A" & A).Offset(1).Resize(X).EntireRow.Insert A = A + X Next End With End Sub '--------------------------------------------------------- MichD
jip
Le lundi 4 décembre 2017 15:13:11 UTC+1, Michd a écrit :
Bonjour, Essaie comme ceci. N'oublie pas d'adapter le nom de la feuille. '---------------------------------------------------------
Bonjour Merci ça a l'air de fonctionner. Cependant : J'ai 501 lignes au total sur le 1er cas, il faudrait 500, c'est pour cela q ue je disais "autant de lignes que le chiffre de la colonne C -1". Surement le "-1" à caser quelque part ? J'ai une erreur ici (>>>>) : Sub insertXlignes() Dim N As Long, Rg As Range Dim AddRow As Long, A As Long Dim X As Long With Worksheets("Feuil1") 'nom à adapter 'définir la plage de cellules (sans ligne vide) Set Rg = .Range("C1:C66" & .Range("C" & .Rows.Count).End(xlUp).Row) 'Le nombre total de lignes à ajouter AddRow = Application.Sum(Rg) 'Lignes ajoutées + lignes déjà existantes N = AddRow + Rg.Rows.Count 'Je suppose que le tableau début en ligne 1, à adapter au bes oin. For A = 1 To N X = .Range("C" & A).Value
Cependant :
J'ai 501 lignes au total sur le 1er cas, il faudrait 500, c'est pour cela q ue je disais "autant de lignes que le chiffre de la colonne C -1". Surement le "-1" à caser quelque part ?
J'ai une erreur ici (>>>>) :
Sub insertXlignes()
Dim N As Long, Rg As Range
Dim AddRow As Long, A As Long
Dim X As Long
With Worksheets("Feuil1") 'nom à adapter
'définir la plage de cellules (sans ligne vide)
Set Rg = .Range("C1:C66" & .Range("C" & .Rows.Count).End(xlUp).Row)
'Le nombre total de lignes à ajouter
AddRow = Application.Sum(Rg)
'Lignes ajoutées + lignes déjà existantes
N = AddRow + Rg.Rows.Count
'Je suppose que le tableau début en ligne 1, à adapter au bes oin.
For A = 1 To N
X = .Range("C" & A).Value
Le lundi 4 décembre 2017 15:13:11 UTC+1, Michd a écrit :
Bonjour, Essaie comme ceci. N'oublie pas d'adapter le nom de la feuille. '---------------------------------------------------------
Bonjour Merci ça a l'air de fonctionner. Cependant : J'ai 501 lignes au total sur le 1er cas, il faudrait 500, c'est pour cela q ue je disais "autant de lignes que le chiffre de la colonne C -1". Surement le "-1" à caser quelque part ? J'ai une erreur ici (>>>>) : Sub insertXlignes() Dim N As Long, Rg As Range Dim AddRow As Long, A As Long Dim X As Long With Worksheets("Feuil1") 'nom à adapter 'définir la plage de cellules (sans ligne vide) Set Rg = .Range("C1:C66" & .Range("C" & .Rows.Count).End(xlUp).Row) 'Le nombre total de lignes à ajouter AddRow = Application.Sum(Rg) 'Lignes ajoutées + lignes déjà existantes N = AddRow + Rg.Rows.Count 'Je suppose que le tableau début en ligne 1, à adapter au bes oin. For A = 1 To N X = .Range("C" & A).Value
A = A + X Next End With End Sub Merci Cordialement
Michd
Essaie ceci. Avec cette procédure, tu peux avoir des cellules vides en C '------------------------------------------------------- Sub test() Dim N As Long, Rg As Range Dim AddRow As Long, A As Long Dim X As Long With Worksheets("Feuil13") 'nom à adapter 'définir la plage de cellules (sans ligne vide) Set Rg = .Range("C1:C" & .Range("C" & .Rows.Count).End(xlUp).Row) 'Le nombre total de lignes à ajouter AddRow = Application.Sum(Rg) 'Lignes ajoutées + lignes déjà existantes N = AddRow + Rg(1, 1).Row + Application.CountBlank(Rg) 'Je suppose que le tableau début en ligne 1 For A = 5 To N If .Range("C" & A) = "" Then Else X = .Range("C" & A).Value - 1 If X > 0 Then .Range("A" & A).Offset(1).Resize(X).EntireRow.Insert A = A + X End If End If Next End With End Sub '------------------------------------------------------- MichD
Essaie ceci. Avec cette procédure, tu peux avoir des cellules vides en C
'-------------------------------------------------------
Sub test()
Dim N As Long, Rg As Range
Dim AddRow As Long, A As Long
Dim X As Long
With Worksheets("Feuil13") 'nom à adapter
'définir la plage de cellules (sans ligne vide)
Set Rg = .Range("C1:C" & .Range("C" & .Rows.Count).End(xlUp).Row)
'Le nombre total de lignes à ajouter
AddRow = Application.Sum(Rg)
'Lignes ajoutées + lignes déjà existantes
N = AddRow + Rg(1, 1).Row + Application.CountBlank(Rg)
'Je suppose que le tableau début en ligne 1
For A = 5 To N
If .Range("C" & A) = "" Then
Else
X = .Range("C" & A).Value - 1
If X > 0 Then
.Range("A" & A).Offset(1).Resize(X).EntireRow.Insert
A = A + X
End If
End If
Next
End With
End Sub
'-------------------------------------------------------
Essaie ceci. Avec cette procédure, tu peux avoir des cellules vides en C '------------------------------------------------------- Sub test() Dim N As Long, Rg As Range Dim AddRow As Long, A As Long Dim X As Long With Worksheets("Feuil13") 'nom à adapter 'définir la plage de cellules (sans ligne vide) Set Rg = .Range("C1:C" & .Range("C" & .Rows.Count).End(xlUp).Row) 'Le nombre total de lignes à ajouter AddRow = Application.Sum(Rg) 'Lignes ajoutées + lignes déjà existantes N = AddRow + Rg(1, 1).Row + Application.CountBlank(Rg) 'Je suppose que le tableau début en ligne 1 For A = 5 To N If .Range("C" & A) = "" Then Else X = .Range("C" & A).Value - 1 If X > 0 Then .Range("A" & A).Offset(1).Resize(X).EntireRow.Insert A = A + X End If End If Next End With End Sub '------------------------------------------------------- MichD
