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

 

[Alex Blakenburg]

Can I clarify what you are trying to do. The code you are using does is not consistent with what you seem to doing.

Do you just want to copy C9 to L (last row) from sheet 1 to 2 and to C9 in Sheet 2 ?

If so you would be wanting something more like the below:

Sub CopyData()

    Dim srcSht As Worksheet, destSht As Worksheet
    Dim srcRng As Range
    Dim srcLastRow As Long
    
    Application.ScreenUpdating = False
    
    Set srcSht = Worksheets("Sheet1")
    Set destSht = Worksheets("Sheet2")
    
    srcLastRow = srcSht.Range("C" & Rows.Count).End(xlUp).Row
    Set srcRng = srcSht.Range("C9:L" & srcLastRow)
    
    srcRng.Copy
    destSht.Range("C9").PasteSpecial Paste:=xlPasteValues
    destSht.Range("C9").PasteSpecial Paste:=xlPasteFormats
    
    destSht.Activate
    destSht.Range("C9").Select
    
    Application.CutCopyMode = False
    Application.ScreenUpdating = True

End Sub

 

[Kalkomania]

hello, tnx for your quick answer
but i need to copy each row from sheet 1 the number of times thats inicated in the column L to the sheet 2
hope that i explain my self
tnx again for your time

 

[Alex Blakenburg]

Is the formatting the same on all rows ?

 

[Kalkomania]

Yes we keep the same format + values like in the sheet 1 in all rows, thank you!!

 

[Alex Blakenburg]

Are the headings on C9 or C8 ?
Will the headings already be on Sheet2 or will they need to be copied ?

 

[Kalkomania]

the C8 already contains the headings in the sheet 2 and the rows starts from C9

 

[Alex Blakenburg]

I did the below before getting your reply and since I am unsure of whether you mean the heading or the data starts on C9 give the below a try.
It assumes the headings are on C9 and it does copy the headings across but assuming they are the same it won't matter and it is an easy change if we need to change it.

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(9))
    ReDim destArr(1 To NoOfLines, 1 To UBound(srcArr, 2))
   
    For iRow = 2 To UBound(srcArr)
        For iLines = 1 To srcArr(iRow, 9)
            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

 

[Kalkomania]

the code its work but its seems to be copying de row just 1 time( not the number of times of cell L) and the row 10 its repeting like for ever.
its need to copy the number of times thats indicates in the column L for each row

 

[Alex Blakenburg]

It is generally a good idea to provide an XL2BB of some sample data and not just a screen shot. It often takes as much time to create some sample data as it does to come up with a solution, it also leads to errors .

In the 2 lines indicated below change the number from a 9 to a 10

    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)