Gå til hovedindhold

Hvordan duplikeres rækker baseret på celleværdi i en kolonne?

Forfatter: Xiaoyang Sidst ændret: 2023-05-04

For eksempel har jeg en række data, der indeholder en liste over tal i kolonne D, og ​​nu vil jeg duplikere hele rækkerne et antal gange baseret på de numeriske værdier i kolonne D for at få følgende resultat. Hvordan kunne jeg kopiere rækkerne flere gange baseret på celleværdierne i Excel?

Kopier rækker flere gange baseret på celleværdier med VBA-kode

Kopier og indsæt rækker baseret på et angivet antal gange med et praktisk værktøj - Kutools til Excel


Kopier rækker flere gange baseret på celleværdier med VBA-kode

For at kopiere og duplikere hele rækkerne flere gange baseret på celleværdierne, kan følgende VBA-kode hjælpe dig, gør venligst som dette:

1. Hold nede ALT + F11 nøgler til at åbne Microsoft Visual Basic til applikationer vindue.

2. Klik indsatte > Moduler, og indsæt følgende kode i Moduler Vindue.

VBA-kode: Kopier rækker flere gange baseret på celleværdi:

Sub CopyData()
'Updateby Extendoffice
    Dim xRow As Long
    Dim VInSertNum As Variant
    xRow = 1
    Application.ScreenUpdating = False
    Do While (Cells(xRow, "A") <> "")
        VInSertNum = Cells(xRow, "D")
        If ((VInSertNum > 1) And IsNumeric(VInSertNum)) Then
           Range(Cells(xRow, "A"), Cells(xRow, "D")).Copy
           Range(Cells(xRow + 1, "A"), Cells(xRow + VInSertNum - 1, "D")).Select
           Selection.Insert Shift:=xlDown
           xRow = xRow + VInSertNum - 1
        End If
        xRow = xRow + 1
    Loop
    Application.ScreenUpdating = False
End Sub

3. Tryk derefter på F5 nøgle til at køre denne kode, er hele rækkerne duplikeret flere gange baseret på celleværdien i kolonne D, som du har brug for.

Bemærk: I ovenstående kode, brevet A angiver startkolonnen i dit dataområde og bogstavet D er det kolonnebrev, som du vil duplikere rækkerne baseret på. Skift dem til dit behov.

Kopier og indsæt rækker baseret på et angivet antal gange med et praktisk værktøj - Kutools til Excel

Hvis du ikke er bekendt med VBA-koden og ikke selv er i stand til at ændre parametrene i koden korrekt. I dette tilfælde Kutools til Excel's Dublerede rækker/kolonner baseret på celleværdi funktionen kan hjælpe dig med at kopiere og indsætte rækker flere gange baseret på celleværdierne med kun tre klik.

Tips: For at anvende dette Kopier rækker / kolonner baseret på celleværdi funktion, bør du download Kutools til Excel først.
  1. Klik Kutools > indsatte > Dublerede rækker/kolonner baseret på celleværdi for at aktivere denne funktion;
  2. Vælg derefter Kopier og indsæt rækker mulighed, og angiv cellerne i Indsæt rækkevidde og Gentag gange separat i dialogboksen.

Bedste kontorproduktivitetsværktøjer

🤖 Kutools AI Aide: Revolutionér dataanalyse baseret på: Intelligent udførelse   |  Generer kode  |  Opret brugerdefinerede formler  |  Analyser data og generer diagrammer  |  Aktiver Kutools funktioner...
Populære funktioner: Find, fremhæv eller identificer dubletter   |  Slet tomme rækker   |  Kombiner kolonner eller celler uden at miste data   |   Runde uden formel ...
Super opslag: VLookup med flere kriterier    Multiple Value VLookup  |   VOpslag på tværs af flere ark   |   Fuzzy Lookup ....
Avanceret rulleliste: Opret hurtigt rulleliste   |  Afhængig rulleliste   |  Multivælg rulleliste ....
Column Manager: Tilføj et bestemt antal kolonner  |  Flyt kolonner  |  Skift synlighedsstatus for skjulte kolonner  |  Sammenlign områder og kolonner ...
Fremhævede funktioner: Grid fokus   |  Designvisning   |   Stor Formel Bar    Arbejdsbog & Ark Manager   |  Ressourcebibliotek (Autotekst)   |  Datovælger   |  Kombiner regneark   |  Krypter/Dekrypter celler    Send e-mails efter liste   |  Superfilter   |   Specielt filter (filter fed/kursiv/gennemstreget...) ...
Top 15 værktøjssæt12 tekst Værktøjer (tilføje tekst, Fjern tegn, ...)   |   50 + Chart Typer (Gantt kort, ...)   |   40+ Praktisk formler (Beregn alder baseret på fødselsdag, ...)   |   19 Indsættelse Værktøjer (Indsæt QR-kode, Indsæt billede fra sti, ...)   |   12 Konvertering Værktøjer (Tal til ord, Valutaomregning, ...)   |   7 Flet og del Værktøjer (Avancerede kombinere rækker, Opdel celler, ...)   |   ... og mere

Overlad dine Excel-færdigheder med Kutools til Excel, og oplev effektivitet som aldrig før. Kutools til Excel tilbyder over 300 avancerede funktioner for at øge produktiviteten og spare tid.  Klik her for at få den funktion, du har mest brug for...

Beskrivelse


Fanen Office bringer en grænseflade til et kontor med Office, og gør dit arbejde meget lettere

  • Aktiver redigering og læsning af faner i Word, Excel, PowerPoint, Publisher, Access, Visio og Project.
  • Åbn og opret flere dokumenter i nye faner i det samme vindue snarere end i nye vinduer.
  • Øger din produktivitet med 50 % og reducerer hundredvis af museklik for dig hver dag!
Comments (43)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
the formula worked when the data set in a column has no blank row. however, it won't work if there is a blank row separating the rows with data. is there any script to add to work it just like that?
This comment was minimized by the moderator on the site
Hello, Charies,
Yes, as you said, the code will not work if there are blank rows in the data range. To solve this issue, please apply the below modified code:
Sub CopyData()
    ' Update by Extendoffice
    Dim xRow As Long
    Dim VInSertNum As Variant
    Dim LastRow As Long
    
    Application.ScreenUpdating = False
    ' Find the last row with data in column A
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row

    xRow = 1
    Do While xRow <= LastRow
        ' Check if there is data in column A of the current row
        If Cells(xRow, "A") <> "" Then
            VInSertNum = Cells(xRow, "D")
            If IsNumeric(VInSertNum) And VInSertNum > 1 Then
                Range(Cells(xRow, "A"), Cells(xRow, "D")).Copy
                Range(Cells(xRow + 1, "A"), Cells(xRow + VInSertNum - 1, "D")).Select
                Selection.Insert Shift:=xlDown
                ' Update LastRow due to insertion
                LastRow = LastRow + VInSertNum - 1
                xRow = xRow + VInSertNum - 1 ' Move xRow to the row after the last inserted
            End If
        End If
        xRow = xRow + 1
    Loop

    Application.ScreenUpdating = True
End Sub



Please have a try, hope it can help you!
This comment was minimized by the moderator on the site
Hi All,
Can anyone give me the code to copy whole table at the same time?.
This comment was minimized by the moderator on the site
Hello, Aparna,
Maybe the following article can help you.
https://www.extendoffice.com/documents/excel/3682-excel-copy-and-insert-row-multiple-times.html#a2
Please view it, if you have any other problem, please comment here.
This comment was minimized by the moderator on the site
Is there any way to get this to work on a shared workbook? it works perfectly until I share the workbook then i get "insert method of range class failed"
This comment was minimized by the moderator on the site
Bonjour,
Merci pour ce code qui fonctionne bien.
Par contre dans mon tableau j'ai une date pour chaque ligne:
J'aimerai qu'elle s'incrémente au fur et à mesure des duplications de lignes et en automatique, car il y a plus de 1000 dossiers différents.

N° dossier Date Nb de jours
2101007 29/01/2021 49
2110002 11/10/2021 22
2008006 31/08/2020 132

pour donner:
N° dossier Date Nb de jours
2101007 29/01/2021 49
2101007 30/01/2021 49
...

Est-ce possible ?
Merci par avance.
This comment was minimized by the moderator on the site
Thank you so much for this!
This comment was minimized by the moderator on the site
What if I wanted to do the above (nice job btw) but what if I wanted to change the dates by “X” days when I add the rows? Like a reoccurring event in a calendar. 
This comment was minimized by the moderator on the site
This is PERFECTION! Short Sweet and to the point as well as easily adaptable!
THANK YOU!
This comment was minimized by the moderator on the site

this is wondeful thank you so much
This comment was minimized by the moderator on the site
I tried running it by pressing F5 and a pop up message below:
"Compile Error:Sub or function not defined."
What am I doing wrong? I adjusted column A and changed A & D as needed.
This comment was minimized by the moderator on the site
Hi, this does not work for me. I copy the code, change the column letter D to the column letter that I want to duplicate rows based upon, and... nothing happens when I run the code. I have enabled macros and tried on two different computers. What am I doing wrong?
This comment was minimized by the moderator on the site
Hi, Sean,
Note: In the above code, the letter A indicates the start column of your data range, and the letter D is the column letter that you want to duplicate the rows based on. Please change them to your need.
Have you adjust the column A of your data? please check it, thank you!

There are no comments posted here yet
Load More
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations