vba excel copy-paste all data x number of times between sheet 1 and 2

[Kalkomania]

Hello all! It's a pleasure to be here, love this site.
i need some help with this excel file,
i have to copy al the data between C9 and L (L=number of times of copies), from sheet 1 too sheet 2 in that same order with all the values and formats from sheet 1.
in sheet 2 has to be copied all the data.
right now i am using the folowing code that i copied from another threat but i cant modify it to copy to he sheet 2 with all formats and values.
Can you please help me? Thank you in advance!

Sub CopyLines()



Dim srcSht As Worksheet, destSht As Worksheet

Dim srcRng As Range, destRng As Range

Dim srcLRow As Long, destLRow As Long

Dim srcArr As Variant, destArr() As Variant

Dim NoOfLines As Long, destRow As Long

Dim iRow As Long, iCol As Long, iLines As Long



Set srcSht = Worksheets("Sheet1")

Set destSht = Worksheets("Sheet2")



srcLRow = srcSht.Range("C" & Rows.Count).End(xlUp).Row

Set srcRng = srcSht.Range("C9:L" & srcLRow)

srcArr = srcRng

NoOfLines = Application.Sum(srcRng.Columns(10))

ReDim destArr(1 To NoOfLines, 1 To UBound(srcArr, 2))



For iRow = 1 To UBound(srcArr)

For iLines = 1 To srcArr(iRow, 10)

destRow = destRow + 1

For iCol = 1 To UBound(srcArr, 2)

destArr(destRow, iCol) = srcArr(iRow, iCol)

Next iCol

Next iLines

Next iRow



destSht.Range("C9").Resize(UBound(destArr, 1), UBound(destArr, 2)).Value = destArr



End Sub

 

[Kalkomania]

hi, i changed the code as you indicate and works, but the first row C9 is copying without taking in consderation the number of copies that are in L9, its copying just one line.
sorry for all ur troble, at this time i cant do the xl2bb sheet in my work computer.

this is the code like i have it right now

Sub CopyLinesMulipleTimes()



Dim srcSht As Worksheet, destSht As Worksheet

Dim srcRng As Range, destRng As Range

Dim srcLRow As Long, destLRow As Long

Dim srcArr As Variant, destArr() As Variant

Dim NoOfLines As Long, destRow As Long

Dim iRow As Long, iCol As Long, iLines As Long



Application.ScreenUpdating = False



Set srcSht = Worksheets("Sheet1")

Set destSht = Worksheets("Sheet2")



srcLRow = srcSht.Range("C" & Rows.Count).End(xlUp).Row

Set srcRng = srcSht.Range("C9:L" & srcLRow)

srcArr = srcRng

NoOfLines = Application.Sum(srcRng.Columns(10))

ReDim destArr(1 To NoOfLines, 1 To UBound(srcArr, 2))



For iRow = 2 To UBound(srcArr)

For iLines = 1 To srcArr(iRow, 10)

destRow = destRow + 1

For iCol = 1 To UBound(srcArr, 2)

destArr(destRow, iCol) = srcArr(iRow, iCol)

Next iCol

Next iLines

Next iRow



Set destRng = destSht.Range("C10").Resize(UBound(destArr, 1), UBound(destArr, 2))

destRng.Value = destArr



srcRng.Rows(2).Copy

destRng.PasteSpecial Paste:=xlPasteFormats



srcRng.Rows(1).Copy destRng.Rows(1).Offset(-1)



Application.CutCopyMode = False

destSht.Activate

destSht.Range("C9").Select

Application.ScreenUpdating = True



End Sub



and the screnshots of the shee 1 and 2

thanks again for you time and interes

 

[Kalkomania]

Hello again, i tried all the ways i know to do this file work but no luck at it.
I searched through the forum this weekend but i can't find anything useful.
Any kind of help is appreciated
Thanks