Блог

Мне нужно скопировать формулы из первой строки приведенного ниже шаблона листа Excel по крайней мере для 5000 строк.

• Задача 1 обновить формулы (я включил 2 варианта, и первый кажется немного быстрее)
• Задача 2 вставьте обновленные значения
• Задача 3 скопируйте форматы из первой строки в последнюю

Я использую следующий код, но он должен замедлиться. Есть ли более быстрое решение? Пожалуйста, не могли бы вы мне помочь?

Большое спасибо

  Sub Refresh_cs()

‘ CS_PASTE_AREA = “A10:QZ5000”

Application.ScreenUpdating = FALSE

Dim Arr             As Variant
If ActiveSheet.FilterMode = TRUE Then
    ActiveSheet.ShowAllData
End If

**'1a REFRESHING Option 1**

'REFRESHING Calculation Sheet
ActiveSheet.Outline.ShowLevels RowLevels:=4
ActiveSheet.Range("A9").EntireRow.Copy
Range("CS_PASTE_AREA").Select 
Selection.PasteSpecial Paste:=xlFormulas

**‘1b Refreshing Option 2**

Dim lastrow         As Long
Dim lastcol         As Long

' Find last CS Row
lastrow = Range("N3").Value - 1 - ActiveCell.Row
' Find last CS Column
ActiveSheet.Range("A9").Select
lastcol = ActiveSheet.Cells(ActiveCell.Row, Application.Columns.Count).End(xlToLeft).Column
'Range(ActiveCell, ActiveCell.Offset(0, lastcol - 1)).Select

Application.Calculation = xlCalculationManual
Arr = Range(ActiveCell, ActiveCell.Offset(0, lastcol - 1))

Range("A10").Resize(lastrow, UBound(Arr, 2)).Formula = Range(ActiveCell, ActiveCell.Offset(0, lastcol - 1)).Formula
Application.Calculation = xlCalculationAutomatic

' 2 PASTE VALUES
Range("CS_PASTE_AREA").Copy
Selection.PasteSpecial Paste:=xlValues
Application.CutCopyMode = False  

' 3 PASTE FORMATS
ActiveSheet.Range("A10").EntireRow.Copy
Range("CS_PASTE_AREA").Select
Selection.PasteSpecial Paste:=xlFormats
Application.CutCopyMode = FALSE

Range("CS_END") = "-"

'ActiveSheet.Outline.ShowLevels RowLevels:=1

Application.ScreenUpdating = TRUE

End Sub