Copy/Paste Formula -> Value Loop

[ipperz]

Hello,

First time poster, long time listener. I'm am looking to do the below:

1) Formulas located in A2:S43
2) Copy/Paste those formulas in row 46 (leaving row 44 & 45 blank)
3) Copy A46:S87 (just pasted box), and paste the values and formatting into itself (A46:S87)
4) Loop 1-3 times the value listed in cell A1

Looking to do this because leaving formulas and looping a large amount of that size is hindering processing speed. Ideally, the pasted boxes below would calculate formulas, then return values in the same space. Below is the round-about way I've tried this:

Sub Calc_Sheet_Setup()

'Copy/Pastes A2:S43 the number of times equaling value from cell A1 in Calc Sheet


Sheets("Calc Sheet").Select
    Application.ScreenUpdating = False
    Calculation = xlCalculationManual
    
    For i = 1 To Worksheets("Calc Sheet").Range("A1").Value
      Range("A2:S43").Copy Destination:=Range("A2").Offset(44 * i)
    
     Next i
    
'Copy/Paste two pasted boxes (A46:S131) values to the right (Column U), then cut that over onto A46


    Range("A46:S131").Select
    Selection.Copy
        Range("U46").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        
  Range("U46").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Cut


    Range("A46").Select
    ActiveSheet.Paste
        
    Application.ScreenUpdating = True
    Calculation = xlCalculationAutomatic
    
End Sub

Thanks for any insight!

 

[cerfani]

What about your code doesn't work?

 

[ipperz]

Right now, it's (copy/pasting the A2:S43 boxes in Offset * A1 value) first, then doing the workaround to replace with values.

If A1 is 50+, it's pasting over 2,000 rows of formulas and it's taking quite a while to process before completing the value replacement.

I was hoping for it to paste formula -> replace with it's own values -> move on to next paste. This would avoid having 2,000+ rows of formulas all at the same time.

Cheers, thanks!

 

[cerfani]

Sub Calc_Sheet_Setup()
    Dim calcSheet As Worksheet
    Set calcSheet = Sheets("Calc Sheet")
    Application.ScreenUpdating = False
    Calculation = xlCalculationManual

    With calcSheet
        For i = 1 To .Range("A1").Value
            .Range("A2:S43").Copy Destination:=.Range("A2").Offset(44 * i)
        Next i

        .Range("A46:S131").Copy
        .Range("U46").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        .Range("U46").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        .Range("U46").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

        Application.CutCopyMode = False
        .Range("U46").Cut .Range("A46")
    End With

    Application.ScreenUpdating = True
    Calculation = xlCalculationAutomatic
End Sub

I rewrote your code so it is easier to see what you are doing. I would avoid writing the macro how the recorder does. Avoid using selection so it is easier to see how your code works.

The code looks like it will only work for a certain value in A1 and not dynamic where it could handle any value. Since you limit it to copying A46:S131. Maybe looking at your code this way helps you see what you are doing wrong. Also you paste values on 46 twice in a row which seems unnecessary.

 

[ipperz]

I played around with it and solved it! The below copies the box range, pastes formulas offset every 44 rows, then pastes values of itself on...itself.

Sub Calc_Sheet_Setup()

'Copy/Pastes A2:S43 the number of times equaling highest employee count from "Previous" or "Current" (From cell A1 in Calc Sheet)


Sheets("Calc Sheet").Select
    Application.ScreenUpdating = False
    Calculation = xlCalculationManual
    
    For i = 1 To Worksheets("Calc Sheet").Range("A1").Value
      Range("A2:S43").Copy Destination:=Range("A2").Offset(44 * i)
    
    
'Copy/Paste below formulas into values over itself


    Range("A2:S43").Offset(44 * i).Select
    Selection.Copy
    Range("A2").Offset(44 * i).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Cut


    Range("A2").Offset(44 * i).Select
    ActiveSheet.Paste
    Next i
    
    Application.ScreenUpdating = True
    Calculation = xlCalculationAutomatic
  
End Sub