Dupliquer des lignes Excel en BVA avec une valeur multiplicateur
Résolu
sakura56
Messages postés
4
Statut
Membre
-
_Gabacho -
_Gabacho -
Bonjour,
Après lecture du post fait sur le même thème, "EXCEL copier les lignes par un multiplicateur", je n'arrive pas à adapter la macro proposée pour mon cas... Désolé mon VBA est resté coincée avant l'an 2000 ... :)
J'ai une table sur une feuille 1 (les valeurs vont de (A2;J523) hors la ligne 1 qui sont mes en têtes) et j'ai besoin que les lignes soient dupliquées sur un autre onglet (feuille 2) autant de fois que mentionnées dans la colonne D
J'ai dupliqué la ligne d'en tête sur la feuille 2
Quelqu'un pourrait-il me pointer les modifications à opérer ?
Merci d'avance
Voici la macro proposée par michel_m
Option Explicit
Sub dupliquer_n_fois()
Dim Derlig1 As Long, Lig As Long, Nbre As Integer, T_in()
Dim Derlig2 As Long
Application.ScreenUpdating = False
Sheets(2).Range("A2:D30000").Clear
With Sheets(1)
Derlig1 = .Columns("A").Find("*", , , , , xlPrevious).Row
For Lig = 2 To Derlig1
Nbre = .Cells(Lig, "E")
T_in = .Range(.Cells(Lig, "A"), .Cells(Lig, "D")).Value
With Sheets(2)
Derlig2 = .Columns("A").Find("", .Range("A1")).Row
.Cells(Derlig2, "A").Resize(Nbre, 4) = T_in
End With
Next
End With
Sheets(2).Select
End Sub
Après lecture du post fait sur le même thème, "EXCEL copier les lignes par un multiplicateur", je n'arrive pas à adapter la macro proposée pour mon cas... Désolé mon VBA est resté coincée avant l'an 2000 ... :)
J'ai une table sur une feuille 1 (les valeurs vont de (A2;J523) hors la ligne 1 qui sont mes en têtes) et j'ai besoin que les lignes soient dupliquées sur un autre onglet (feuille 2) autant de fois que mentionnées dans la colonne D
J'ai dupliqué la ligne d'en tête sur la feuille 2
Quelqu'un pourrait-il me pointer les modifications à opérer ?
Merci d'avance
Voici la macro proposée par michel_m
Option Explicit
Sub dupliquer_n_fois()
Dim Derlig1 As Long, Lig As Long, Nbre As Integer, T_in()
Dim Derlig2 As Long
Application.ScreenUpdating = False
Sheets(2).Range("A2:D30000").Clear
With Sheets(1)
Derlig1 = .Columns("A").Find("*", , , , , xlPrevious).Row
For Lig = 2 To Derlig1
Nbre = .Cells(Lig, "E")
T_in = .Range(.Cells(Lig, "A"), .Cells(Lig, "D")).Value
With Sheets(2)
Derlig2 = .Columns("A").Find("", .Range("A1")).Row
.Cells(Derlig2, "A").Resize(Nbre, 4) = T_in
End With
Next
End With
Sheets(2).Select
End Sub
A voir également:
- Dupliquer des lignes Excel en BVA avec une valeur multiplicateur
- Dupliquer ecran - Guide
- Liste déroulante excel - Guide
- Déplacer une colonne excel - Guide
- Partager des photos en ligne - Guide
- Word et excel gratuit - Guide
1 réponse
Bonjour,
Option Explicit Sub dupliquer_n_fois() Dim Derlig1 As Long, Lig As Long, Nbre As Integer, T_in() Dim Derlig2 As Long 'les valeurs vont de (A2;J523) 'autant de fois que mentionnées dans la colonne D Application.ScreenUpdating = False With Sheets(2) Derlig2 = .Columns("A").Find("", .Range("A1")).Row .Range("A2:J" & Derlig2).Clear End With With Sheets(1) Derlig1 = .Columns("A").Find("*", , , , , xlPrevious).Row For Lig = 2 To Derlig1 Nbre = .Cells(Lig, "D") T_in = .Range(.Cells(Lig, "A"), .Cells(Lig, "J")).Value With Sheets(2) Derlig2 = .Columns("A").Find("", .Range("A1")).Row .Cells(Derlig2, "A").Resize(Nbre, 10) = T_in End With Next Lig End With Sheets(2).Select End Sub
Définitivement je n'aurai pas réussi sans aide ... Merci beaucoup et en plus sous un délai canon
Bonne journée !
J'ai le même souci dans un tableau allant de A2 à N6000 et j'ai besoin que les lignes soient dupliquées autant de fois que mentionné en colonne E.
Seulement je n'arrive pas à lancer la macro décrite au dessus. J'ai essayé de l'adapter mais j'ai du faire une erreur car j'ai un message d'erreur : "Erreur d'exécution 91, variable objet ou variable de bloc With non définie".
Quelqu'un aurait -il la gentillesse de m'aider ?
Voici ma macro :
Sub dupliquer_n_fois()
Dim Derlig1 As Long, Lig As Long, Nbre As Integer, T_in()
Dim Derlig2 As Long
Application.ScreenUpdating = False
Sheets(2).Range("A2:N7000").Clear
With Sheets(1)
Derlig1 = .Columns("A").Find("*", , , , , xlPrevious).Row
For Lig = 2 To Derlig1
Nbre = .Cells(Lig, "E")
T_in = .Range(.Cells(Lig, "A"), .Cells(Lig, "N")).Value
With Sheets(2)
Derlig2 = .Columns("A").Find("", .Range("A1")).Row
.Cells(Derlig2, "A").Resize(Nbre, 14) = T_in
End With
Next
End With
Sheets(2).Select
End Sub