Rijen kopiëren met regels ertussen

[Rusty1979]

Goedenavond,

Voor het aanmaken van een offerte heb ik de keuze uit een x aantal producten (in deze voorbeeld sheet 10 producten).
Graag wil ik de artikelen, waarvan er minimaal 1 in de kolom Aantal staat, kopiëren naar de Offerte met telkens 2 wit regels ertussen.
Zoals ik dat hier heb gedaan met Product A, C en E.

Ik moet hier vast een loop voor maken, maar heb geen idee hoe ik dat moet opzetten, heeft iemand enig idee?
Natuurlijk moet het aantal en de prijs e.d. ook allemaal mee gekopieerd worden, maar als ik een opzet heb kom ik er wel verder mee.

 

[VenA]

Dan pas je de rijhoogte toch aan?

 

[HSV]

Sub hsv()
Dim sv, i As Long, j As Long, n As Long
sv = Cells(1, 9).CurrentRegion
ReDim hs(2, UBound(sv) * 3)
 For i = 2 To UBound(sv)
   If sv(i, 3) > 0 Then
     For j = 0 To 2
       hs(j, n) = sv(i, j + 1)
       hs(j, n + 1) = ""
       hs(j, n + 2) = ""
     Next j
       n = n + 3
   End If
  Next i
Cells(3, 1).Resize(n, 3) = Application.Transpose(hs)
End Sub

 

[Timshel]

hsv waarom vul je de array horizontaal en transponeer je, in plaats van verticaal vullen?
Werkt als een speer hoor ik vroeg me gewoon af.

 

[HSV]

Ik zat in de modus van 'redim preserve' met uitgangspunt redim(2,0).
Heb dat gesloopt, en de rest is blijven staan.

Je mag het wel even rechtzetten.
Pc net uitgedaan, vanaf mobiel gaat vast fout.

Bedankt,

 

[HSV]

Ach, niet meer nodig zo te zien.

@Rusty1979 heeft niet eens het fatsoen te reageren en de vraag op opgelost gezet.

 

[Rusty1979]

Excuus voor mijn onbeholpenheid. Helaas was ik er nog niet aan toegekomen om te reageren.
Allereerst waardeer ik het heel erg dat jullie de moeite hebben genomen om mee te denken.

Ik heb inmiddels besloten om het probleem wat ik had op een andere manier aan te vliegen.
Het stukje met Resize erin ga ik nog wel even uitproberen.

bedankt nogmaals!