Rij(en kopieren naar nieuw blad

[Tambu]

Beste,

Ik heb een spreadsheet (zie bijlage) met bonnen waar in één cel het aantal (bon)regels staat. Op basis van deze waarde (regel aantal) wil ik de gehele regel, dat aantal keer kopiëren naar een nieuw blad (zie blad 'Gewenst Resultaat'

Weet iemand hoe ik dat kan realiseren?

Peter

 

[Tambu]

Gedeeltelijk Opgelost

Beste,

Dankzij de code van SjonR heb ik voor het grootste deel de oplossing gevonden. Top!

Het enige wat ik graag nog zou willen is dat de kolomnamen (1e rij) ook mee wordt gekopieerd naar het nieuwe blad.

Weet iemand hoe dat zou moeten?

MvG,
Peter

Sub SjonR()
Sheets("Resultaat").UsedRange.Offset(1).ClearContents
With Sheets("Bron")
For i = 2 To .Range("A" & Rows.Count).End(xlUp).Row
    For j = 1 To .Cells(i, 5).Value
        Sheets("Resultaat").Cells(Sheets("Resultaat").Range("A" & Rows.Count).End(xlUp).Row + 1, 1).Resize(, 12).Value = .Cells(i, 1).Resize(, 12).Value
    Next
Next
End With

End Sub

 

[Haije]

Maak eens van
For i = 2 to ..
For i = 1 to ...

 

[HSV]

Sub hsv()
Dim sv, i As Long, j As Long, jj As Long
sv = Sheets("uitgangspunt").Cells(1).CurrentRegion
  ReDim sv2(4, 0)
  For i = 3 To UBound(sv)
    For j = 1 To sv(i, 5)
      For jj = 0 To UBound(sv, 2) - 1
        sv2(jj, UBound(sv2, 2)) = sv(i, jj + 1)
      Next jj
    ReDim Preserve sv2(4, UBound(sv2, 2) + 1)
  Next j
  Next i
  Sheets("gewenst resultaat").Cells(1).Resize(UBound(sv2, 2), UBound(sv2) + 1) = Application.Transpose(sv2)
End Sub

 

[Tambu]

Rijen Kopiëren

Beste,

Het kopiëren van de kolomnamen lukt (nog) niet... ;-) Dus ik hou me nog aanbevolen...

Daarnaast heb ik de code nu toegepast op het daadwerkelijke bestand wat ik ga gebruiken. Daarbij valt me op dat op het bron blad de cel eigenschappen op 'standaard' staan en op het nieuw aangemaakte blad worden de kolommen opgemaakt op basis van wat Excel denkt op te kunnen maken uit het formaat.

Is dat tegen te gaan? Op zich is het geen probleem, maar bij 1 kolom maakt Excel bij het plakken van 4-3554 -> apr-54 en dat is niet de bedoeling.... ;-)

MvG,
Peter

 

[Tambu]

Rijen Kopiëren

Nogmaals super bedankt voor de code om de bon regels te kopiëren op basis van het regel aantal.

De code werkt ook met mijn daadwerkelijke data (zie bijlage) met twee kanttekeningen:

- Kunnen de kolomnamen ook op het nieuwe blad worden meegenomen?
- Bij het plakken past Excel (?) de cel eigenschappen aan. Op zich geen probleem, behalve bij kolom 1. Daar wordt van 4-3549 -> apr-49 van gemaakt. Is daar een oplossing voor?

Alvast bedankt voor de moeite!!!

 

[VenA]

Aanpassing in de code van @HSV
Tussen next i en end sub

With Sheets("ResultaatHSV")
    .Columns(1).NumberFormat = "@"
    .Cells(1).Resize(, 5) = Application.Index(sv, 1, Array(1, 2, 3, 4, 5))
    .Cells(2, 1).Resize(UBound(sv2, 2), UBound(sv2) + 1) = Application.Transpose(sv2)
  End With

 

[HSV]

In onderstaande de 3 ook nog vervangen door een 2.

For i = 3 To UBound(sv)