Duplication lignes à la suite

Bonjour à tous et toutes,

J'ai un petit problème sur l'une de mes macros, je pense que c'est un manquement de ma part mais je ne comprends pas mon erreur.

L'objectif de ma macro est de coller le tableau de l'onglet "Données" (qui va de la cellule A2 à N10) autant de fois qu'il y a de centres dans l'onglet "Param", les uns à la suite des autres.

J'ai fait les deux codes suivants, la première duplication se fait correctement, le balayage de l'onglet "Param" également mais je n'ai qu'une seule duplication et non 20 comme je le souhaiterais.

Sub Duplication()
Dim i As String
Dim DernièreLigne As String

i = 2
DernièreLigne = Sheets("Données").Cells(Rows.Count, 1).End(xlUp).Row + 1

Do While Sheets("Param").Range("A" & i).Value <> ""

    Sheets("Données").Range("A2:N10").Copy
    Sheets("Données").Range("A" & DernièreLigne).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False

    i = i + 1
Loop

End Sub
Sub Duplication2()
Dim DernièreLigne As String
Dim cellule As Range

DernièreLigne = Sheets("Données").Cells(Rows.Count, 1).End(xlUp).Row + 1

For Each cellule In Sheets("Param").Range("A2:A21")

    Sheets("Données").Range("A2:N10").Copy
    Sheets("Données").Range("A" & DernièreLigne).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False

Next

End Sub

Je vous joins également le document si vous pouviez m'aider sur ce sujet, je vous en remercie d'avance.

3duplication.xlsm (18.22 Ko)

Bonne journée et encore merci d'avance

Bonjour,

Sub Duplication3()

Dim I  As Long, DerniereLigne As Long
Dim AireCentres As Range, AireModele As Range
Dim ShDonnees As Worksheet

   Set ShDonnees = Sheets("Données")
   Set AireCentres = Range("Centres")    ' Sheets("Param").range("A2:A21")
   Set AireModele = Range("ZoneModele")  ' ShDonnees.Range("A2:N10")

   With ShDonnees
        For I = 1 To AireCentres.Count
            DerniereLigne = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
            .Cells(DerniereLigne, 1) = AireCentres(I)
            AireModele.Copy Destination:=.Cells(DerniereLigne + 1, 1)
        Next I
   End With

   Set AireCentres = Nothing: Set AireModele = Nothing

End Sub

Bonjour Eric,

Je te remercie beaucoup, ça marche parfaitement.

J'ai une question, si je souhaite que une colonne de l'onglet données soit remplie par l'onglet Param comme ci-dessous. Est-ce possible ?

image

Cordialement,

A tester :

Sub Duplication4()

Dim I  As Long, DerniereLigne As Long
Dim AireCentres As Range, AireModele As Range
Dim ShDonnees As Worksheet

   Set ShDonnees = Sheets("Données")
   Set AireCentres = Range("Centres")    ' Sheets("Param").range("A2:A21")
   Set AireModele = Range("ZoneModele")  ' ShDonnees.Range("A2:N10")

   With ShDonnees
        For I = 1 To AireCentres.Count
            AireModele.Columns(2).Cells = AireCentres(I)
            DerniereLigne = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
            AireModele.Copy Destination:=.Cells(DerniereLigne, 1)
        Next I
   End With

   Set AireCentres = Nothing: Set AireModele = Nothing
   Set ShDonnees = Nothing

End Sub

Ca marche nickel, merci beaucoup pour ton aide.

Bonne journée.

Rechercher des sujets similaires à "duplication lignes suite"