Meerdere teksten dubliceren onder elkaar

[gertvn]

Beste Forumleden/specialisten.

Ik heb een aantal Excel lijsten met tussen de 2 en 10 kolommen met verschillende gegevens per rij, het kan zijn dat er maar 3 kolomen in gevuld zijn en de rest is dan leeg.
Ik moet nu an elke rij de gegevens dupliceren het aantal verschilt dan ook weer per excel lijst, ik ga deze Excellijst in mijn een grafisch pakket gebruiken en moeten de regels per rij erin staan dus als ik 5 keer een woord heb staan dan moet dat woord 5 keer onder elkaar staan.

In het voorbeeld zie je in het invulblad de gegevens staan (tekst 1 t.m tekst 10) in kolom M 2 zou ik dan graag het aantal willen invullen (in het voorbeeld 5 keer) waardoor er in het uitkomst tabblad van elke enkele regel er dan 5 onder elkaar staan. zoals hier onder en in het voorbeeld blad.

Voorbeeld invul blad

QR012 WIW515 Aap Noot appel Peer Peer 01 appel 05 WWW intel
QR013 WIW516 Aap 12 Noot 09 appel Peer Peer 02 appel 06 WWW intel 01
QR014 WIW517 Aap Noot appel Peer Peer 03 appel 07 WWW intel 02

Deze regels heb ik 5 keer nodig zou dit de uitkomt moeten worden
Tekst 1 Tekst 2 Tekst 3 Tekst 4 Tekst 5 Tekst 6 Tekst 7 Tekst 8 Tekst 9 Tekst 10
QR012 WIW515 Aap Noot appel Peer Peer 01 appel 05 WWW intel
QR012 WIW515 Aap Noot appel Peer Peer 01 appel 05 WWW intel
QR012 WIW515 Aap Noot appel Peer Peer 01 appel 05 WWW intel
QR012 WIW515 Aap Noot appel Peer Peer 01 appel 05 WWW intel
QR012 WIW515 Aap Noot appel Peer Peer 01 appel 05 WWW intel
QR013 WIW516 Aap 12 Noot 09 appel Peer Peer 02 appel 06 WWW intel 01
QR013 WIW516 Aap 12 Noot 09 appel Peer Peer 02 appel 06 WWW intel 01
QR013 WIW516 Aap 12 Noot 09 appel Peer Peer 02 appel 06 WWW intel 01
QR013 WIW516 Aap 12 Noot 09 appel Peer Peer 02 appel 06 WWW intel 01
QR013 WIW516 Aap 12 Noot 09 appel Peer Peer 02 appel 06 WWW intel 01
QR014 WIW517 Aap Noot appel Peer Peer 03 appel 07 WWW intel 02
QR014 WIW517 Aap Noot appel Peer Peer 03 appel 07 WWW intel 02
QR014 WIW517 Aap Noot appel Peer Peer 03 appel 07 WWW intel 02
QR014 WIW517 Aap Noot appel Peer Peer 03 appel 07 WWW intel 02
QR014 WIW517 Aap Noot appel Peer Peer 03 appel 07 WWW intel 02

Ik hoop dat er iemand kan helpen met deze vraag want knippen plakken van deze bestanden is erg veel werk

Alvast bedankt voor het meedenken

 

[JEC.]

Voor office 365

=INDEX(Invulblad!A2:J7;REEKS(AANTALARG(Invulblad!A2:A7)*Invulblad!M2;1;1;1/Invulblad!M2);KOLOM(A2:J2))

 

[JEC.]

Kan ook met Power Query

let
    Source = Excel.CurrentWorkbook(){[Name="Tabel1"]}[Content],
    repeat = Table.AddColumn(Source, "Repeat", each {1..Tabel3[aantal per regel]{0}}),
    exprepeat = Table.ExpandListColumn(repeat, "Repeat"),
    dltrepeat = Table.RemoveColumns(exprepeat,{"Repeat"})
in
    dltrepeat

 

[emields]

of met een macro

 

[JEC.]

Nog een variant met een macro, maar dan met gebruik van arrays. Alles wordt in één keer weggeschreven.

Kan ook met een oneliner als je een Excel formule omzet naar VBA.

Sub jec()
 Dim ar As Variant, sq As Variant
 Dim i As Long, j As Long
 
 With Sheets("Invulblad")
   ar = .Cells(1).CurrentRegion
   ReDim sq(1 To (UBound(ar) - 1) * .[M2], 1 To 10)
   For i = 1 To UBound(sq)
      For j = 1 To 10
        sq(i, j) = ar((i - 1) \ .[M2] + 2, j)
      Next
   Next
   Sheets("UITKOMST").Cells(2, 1).Resize(i - 1, 10) = sq
 End With
End Sub

 

[HSV]

Nog een duit.

Sub hsv()
Dim sv, hs, a As String, i As Long, s0 As String
 sv = Blad1.Cells(1).CurrentRegion
 a = Blad1.[M2]
        For i = 1 To UBound(sv)
         s0 = s0 & IIf(i = 1, i, Replace(String(a, " "), " ", " " & i))
        Next
     hs = Split(s0)
  Blad2.Cells(1).Resize(UBound(hs) + 1, UBound(sv, 2)) = Application.Transpose(Application.Index(sv, hs, Evaluate("row(1:" & UBound(sv, 2) & ")")))
End Sub

 

[JEC.]

Zonder loop

Sub jec()
 Dim ar
 With Blad1.Range("A2:J" & Blad1.Range("A" & Rows.Count).End(xlUp).Row)
   ar = Application.Index(.Value, Evaluate("int((row(1:" & .Rows.Count * Blad1.[M2] & ")-1)/'Invulblad'!M2)+1"), [transpose(row(1:10))])
   Blad2.Cells(2, 1).Resize(UBound(ar), UBound(ar, 2)) = ar
 End With
End Sub

 

[HSV]

Keurig,

Ik zou starten op rij 1 en de evaluate beginnen op 5.

With Blad1.cells(1).currentRegion
   ar = Application.Index(.Value, Evaluate("int((row(5:" & .Rows.Count * Blad1.[M2] & ")-1)/'Invulblad'!M2)+1"), [transpose(row(1:10))])
   Blad2.Cells(1).Resize(UBound(ar), UBound(ar, 2)) = ar
 End With

 

[JEC.]

Dat kan ook maar dan moet je de 5 in de evaluatie regel ook variabel maken.
Het aantal te dupliceren regels kan afwijken.

 With Blad1.Cells(1).CurrentRegion
   ar = Application.Index(.Value, Evaluate("int((row(" & Blad1.[M2] & ":" & .Rows.Count * Blad1.[M2] & ")-1)/'Invulblad'!M2)+1"), [transpose(row(1:10))])
   Blad2.Cells(1).Resize(UBound(ar), UBound(ar, 2)) = ar
 End With

 

[gertvn]

Beste forum leden,

Iedereen bedankt voor het meedenken, ik kan hiermee aan de slag:thumb:.

Aangezien ik zelf niet goed ben in het opmaken van Excel bestanden met macro's heb ik het voorbeeld bestand van emields en JEC gebruikt en deze werken perfect met wat ik wil.
De andere ga ik zeker proberen of ik ze werkend krijg zodat ik er in ieder geval weer wat van opsteek en misschien lukt het me dan wel om zelf macro's in te zetten :d.

Nogmaals bedankt:thumb::thumb: