Meerdere rijen dupliceren

[michealmcdermot]

Ik heb een spreadsheet met meer dan 100 rijen. Bestaat er een mogelijkheid om hiervan een 40 tal rijen (die ik handmatig of met filter selecteer) automatisch te dupliceren/kopiëren naar een rij eronder? Dus dat er voor de geselecteerde rijen een extra regel eronder toegevoegd wordt waar dezelfde info als de regel erboven ingevuld wordt?
Ik kom er online niet echt uit...

Alvast met veel dank!

 

[Senso]

How to copy each row in excel and paste it under the copied row​

 

[emields]

voorbeeldbestandje vergeten? Of mogen we zelf onze tijd erin steken om het te maken?

 

[AHulpje]

Zo:

Sub DuplicateRows()
    Dim rng      As Range
    Dim ws       As Worksheet
    Dim rowIndex As Long
    
    Set ws = ActiveSheet
    
    ' Loop through the selected rows in reverse order to prevent shifting issues
    For rowIndex = Selection.Rows.Count To 1 Step -1
        Set rng = Selection.Rows(rowIndex)          ' Get the current row
        
        If rng.Address = rng.EntireRow.Address Then
            rng.Offset(1, 0).Insert xlShiftDown     ' Insert a new row below
            rng.Copy rng.Offset(1, 0)               ' Copy into the new row
        End If
    Next rowIndex
    
    MsgBox "Rows duplicated immediately below.", vbInformation, "Success"
End Sub

 

[cow18]

@AHulpje, vraagje, heb het niet getest. Werkt dat ook als je meerdere niet aaneensluitende areas van je selection hebt ?
denk dat er nog zoiets er bij moet

     With Selection
          For Each ar In .Areas
               For i = 1 To ar.Rows.Count
                    MsgBox ar.Rows(i).Address
               Next
          Next

 

[AHulpje]

@cow18
Scherp opgemerkt en dat zonder te testen!
Bijgaand een nieuwe versie.

 

[emields]

Of zo de tijd op dat je de rijen selecteert zijn ze ook gekopieerd. met dubbelklik in kolom A;
Gelukkig is er altijd wel iemand die zelf een voorbeeldje in elkaar steekt.

 

[AD1957]

vergeten ?

cancel=true

 

[HSV]

Of:

Sub hsv()
 Selection.Copy Cells(Rows.Count, 1).End(xlUp).Offset(1)
 Cells(1).CurrentRegion.Sort Cells(1)
End Sub

 

[emields]

en als je een echte tabel gebruikt kan je het zo doen. zie blad2

 

[michealmcdermot]

Ten eerste, sorry, was niet op de hoogte dat voorbeeldbestand hiervoor gewenst was. Het is me in ieder geval duidelijk dat ik dit voortaan bij alle hulpvragen zal doen!

Ten tweede bedankt voor alle hulp, ik ga er eens induiken! Het is dus niet zo makkelijk met een simpele formule, dat heb ik al wel gezien.

Thanks!