VBA Dupliquer des lignes non vides

Fermé
Valou78310 - 11 oct. 2021 à 16:01
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 - 12 oct. 2021 à 15:43
Bonjour,

Je cherche à dupliquer X fois toutes les lignes de données de ma feuille excel mais ne parviens pas à trouver la manière de procéder.

J'ai trouvé une solution pour réaliser cette opération ligne par ligne mais ce n'est pas très efficace car je dois manuellement me positionner sur une des cellules de la ligne puis exécuter la macro.

Sachant que le nombre de lignes de la feuille excel est variable tout comme la quantité X de ligne à créer.
La variable Lignes renvoie un nombre de jours ouvrés qui varie d'un mois à l'autre.

Je vous remercie d'avance pour votre aide :)

Cordialement


Sub dupliquerLignesV1()
Dim lignes As Integer
Dim debut As Integer
    lignes =
Workbooks("Calendar.xlsm").Sheets("Calendar").Range("C35").Value
    
    For debut = 1 To lignes
        With ActiveCell.EntireRow
            .Offset(debut, 0).Insert Shift:=xlDown
            .Copy Destination:=.Offset(debut, 0)
        End With
    Next debut
End Sub

3 réponses

cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
11 oct. 2021 à 19:00
Bonjour,

comme ceci:

:
Option Explicit
Sub For_X_to_Next_Ligne()
Dim FL1 As Worksheet, NoCol As Integer
Dim NoLig As Long, Var As Variant
Dim i As Integer, n As Integer
    Set FL1 = Worksheets("Feuil1") 'à adapter
    NoCol = 1 'lecture de la colonne A 'à adapter
     n = InputBox("Entrez le nombre de lignes copiées", "Nombre de lignes copiées", "3")
    For NoLig = Split(FL1.UsedRange.Address, "$")(4) To 1 Step -1
        Var = FL1.Cells(NoLig, NoCol)
    For i = 1 To n
    FL1.Cells(NoLig, NoCol).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    FL1.Cells(NoLig, NoCol) = Var
    Next
    Next
    Set FL1 = Nothing
End Sub


0
Bonjour,

Je vous remercie pour votre rapide réponse.
J'ai modifié la variable "n" car dans mon cas je souhaite que cette valeur soit déduite automatiquement par Excel. Ca fonctionne :)

En revanche, j'aurais besoin de dupliquer la ligne entière et pas seulement les cellules de la colonne renseignée. Je n'ai pas trouvé de solution en modifiant la valeur de la variable "NoCol" :(

D'autre part, la ligne d'en tête est également comprise dans la duplication, est ce possible de débuter à la ligne 2 ?

Je vous remercie par avance pour votre aide et reste à votre disposition pour tout complément d'information :)
0
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
12 oct. 2021 à 12:55
D'autre part, la ligne d'en tête est également comprise dans la duplication, est ce possible de débuter à la ligne 2 ?

c'est une boucle qui commence par la dernière ligne en remontant. On finit donc par la ligne 2

voici le code pour la copie de la ligne entière:

Sub For_X_to_Next()
Dim FL1 As Worksheet, NoCol As Integer
Dim NoLig As Long, Var As Variant
Dim i As Integer, n As Integer
    Set FL1 = Worksheets("Feuil1") 'à adapter
    NoCol = 1 'lecture de la colonne A 'à adapter
     n = InputBox("Entrez le nombre de lignes copiées", "Nombre de lignes copiées", "3")
    For NoLig = Split(FL1.UsedRange.Address, "$")(4) To 2 Step -1
        Var = FL1.Cells(NoLig, NoCol)
    For i = 1 To n
    Cells(NoLig, 1).Resize(1, 33).Copy
            FL1.Cells(NoLig, NoCol).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            ActiveSheet.Paste
    Next
    Next
    Set FL1 = Nothing
End Sub


Voilà
0
Bonjour,

Je vous remercie !
Le code fonctionne et duplique bien toutes les lignes, en revanche il garde en mémoire et colle les données d'origine dans la cellule active.

Je n'en ai pas besoin, comment faire pour éviter cette étape svp ?

Bien à vous
0
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
12 oct. 2021 à 15:43
0