How to duplicate each row in every sheet number of times

[glanko07]

HI! I got a new problem. I have 10 sheets and 800 rows per sheet. I want to duplicate each row 1200 times in every sheet and I want do it on go. can anyone help me? P.S each row has a formula, format, and value.

 

[rollis13]

This macro will do what you asked for:

Option Explicit
Sub Copy_Row_1200_Times()
    Dim x      As Long
    Dim ws     As Worksheet
    Application.StatusBar = "Please wait, it takes some time to complete!"
    For Each ws In Worksheets
        For x = 800 To 1 Step -1
            With ws
                .Range("A" & x).EntireRow.Copy
                .Range("A" & x + 1).Resize(1200).Insert
            End With
        Next x
        Application.CutCopyMode = False
    Next ws
    Application.StatusBar = False
    MsgBox "Done!"
End Sub

 

[glanko07]

This macro will do what you asked for:

Option Explicit
Sub Copy_Row_1200_Times()
    Dim x      As Long
    Dim ws     As Worksheet
    Application.StatusBar = "Please wait, it takes some time to complete!"
    For Each ws In Worksheets
        For x = 800 To 1 Step -1
            With ws
                .Range("A" & x).EntireRow.Copy
                .Range("A" & x + 1).Resize(1200).Insert
            End With
        Next x
        Application.CutCopyMode = False
    Next ws
    Application.StatusBar = False
    MsgBox "Done!"
End Sub

I try it and I keep it running for 3 days and then excel doesn't responding

 

[rollis13]

I wonder where your 800 rows are in the sheets, which range ? are your sheets hidden ? are they protected by password ?

 

[Fluff]

Do you have any formulas or formatting that needs to be preserved?
If not how many columns are there?

 

[glanko07]

Okaay so the only formula is count if in column E and F. Every othersheet that named "Worksheet" share similar looks like this one (except difference in first three column)

 

[rollis13]

Nothing special, if the name of the sheets to process all begin with "Worksheet..." then you can add these two lines in this part of the macro to avoid processing sheets that don't need to be updated. The changed line is because you have headers that you didn't mention.

'...
For Each ws In Worksheets
    If ws.Name Like "Worksheet*" Then         '<-- added
        For x = 800 To 2 Step -1              '<-- changed
            With ws
                .Range("A" & x).EntireRow.Copy
                .Range("A" & x + 1).Resize(1200).Insert
            End With
        Next x
        Application.CutCopyMode = False
    End If                                    '<-- added
Next ws
'...

 

[glanko07]

Nothing special, if the name of the sheets to process all begin with "Worksheet..." then you can add these two lines in this part of the macro to avoid processing sheets that don't need to be updated. The changed line is because you have headers that you didn't mention.

'...
For Each ws In Worksheets
    If ws.Name Like "Worksheet*" Then         '<-- added
        For x = 800 To 2 Step -1              '<-- changed
            With ws
                .Range("A" & x).EntireRow.Copy
                .Range("A" & x + 1).Resize(1200).Insert
            End With
        Next x
        Application.CutCopyMode = False
    End If                                    '<-- added
Next ws
'...

Hey, matte! first of all sorry, I forgot I got the headers. I run your codes, leave it overnight, and it works like a champ! Thank you so much! but I got some little problem. When I did your code, the row became 1201 (in contrast to 1200). So I kinda change a code from this "Range("A" & x + 1).Resize(1200).Insert" to this "Range("A" & x + 1).Resize(1199)).Insert" and yeah something weird happened that my excel always calculating (when it get 100% it start another calculating). do you have any ideas why this is happening? Thank you in advance!

 

[glanko07]

as you can see the row has been duplicated but my excel still calculating (idk what it catculating for) and my VBA window seems unresponsive.

 

[rollis13]

I want to duplicate each row 1200 times

That's what you said, you had 1 line to be duplicated 1.200 times and that makes to me a total of 1+1.200=1.201.

change a code from this "Range("A" & x + 1).Resize(1200).Insert" to this "Range("A" & x + 1).Resize(1199)).Insert"

Yes, your intuition is right, that's how to totalize 1200.
Now, as per your issue, as before there shoudn't be any problem unless you are out of memory or overloading your cpu. Restart your PC, use a clean file and relaunch the macro and it should end as required (as said take's time 800x1199=959.200 rows x n.columns = is a lot of work to be done even if you have a new PC).
It would go faster if you add at the beginning of the macro:

Application.ScreenUpdating = False
Application.Calculation = xlManual

and at the end:

Application.ScreenUpdating = True
Application.Calculation = xlAutomatic