VBA code takes too long og Excel stops responding-CodePudding

I have written a code that copies a template from one sheet and pastes this in a different sheet with a new variable to trigger the fuctions in the template, I currently have 115 variables that i need and it takes too long with "DoEvents" and without it excel stops responding. Is there any way to optimize the code? At the end i copy and paste as values in order to save space in the file.

Variables stored in "rng"

Code below:

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Sheets("Flight FS").SelectSheets("Flight FS").Range("c1048576").Select
Selection.End(xlUp).Select
Sheets("Flight FS").Range(ActiveCell, Sheets("Flight FS").Range("C6").End(xlToRight)).Select
Selection.Clear

Dim rng As Range, cell As Range

Set rng = Sheets("Flight FS templ").Range("c45", Sheets("Flight FS 
templ").Range("c45").End(xlDown))



For Each cell In rng
Sheets("Flight FS templ").Select
Sheets("Flight FS templ").Range("c6", Sheets("Flight FS 
templ").Range("i40").End(xlToRight)).Select
Selection.Copy
Sheets("Flight FS").Select
Range("c1048576").Select
Selection.End(xlUp).Select
ActiveCell.Offset(rowoffset:=2, columnoffset:=0).Activate
ActiveSheet.Paste
ActiveCell.Offset(rowoffset:=1, columnoffset:=3).Activate
ActiveCell.Value = cell
DoEvents
Next cell

Application.Calculation = xlCalculationAutomatic
Sheets("Flight FS").Select
Sheets("Flight FS").Range("c1048576").Select
    Selection.End(xlUp).Select
    Sheets("Flight FS").Range(ActiveCell, Sheets("Flight 
FS").Range("C6").End(xlToRight)).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

ActiveSheet.Range("A2").Select

Application.CutCopyMode = False

Application.Calculation = xlCalculationAutomatic

Application.ScreenUpdating = True

End Sub

CodePudding user response：

How to avoid `Select`

Not tested. The code compiles which doesn't mean that it works. Your feedback is appreciated.
I don't know what the formulas in the source range are, but they should be calculated in VBA if they are 'slowing down' your workbook.

Option Explicit

Sub GenerateData()
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Reference the destination worksheet, reference the last cell,
    ' reference and clear the destination range and reference
    ' the destination last cell (see the offsets later in the code).
    Dim dws As Worksheet: Set dws = wb.Worksheets("Flight FS")
    Dim dCell As Range: Set dCell = dws.Cells(dws.Rows.Count, "C").End(xlUp)
    Dim drg As Range ' (left-bottom, top-right)
    Set drg = dws.Range(dCell, dws.Cells(6, dws.Columns.Count).End(xlToLeft))
    drg.Clear
    Set dCell = drg.Cells(1).Offset(-1)
    
    ' Reference the source worksheet, reference the source column range,
    ' reference the source range and calculate the destination offset.
    Dim sws As Worksheet: Set sws = wb.Worksheets("Flight FS templ")
    Dim scrg As Range
    Set scrg = sws.Range("C45", sws.Cells(sws.Rows.Count, "C").End(xlUp))
    Dim srg As Range
    With sws.Range("C6", sws.Cells(6, sws.Columns.Count).End(xlToLeft))
        Set srg = .EntireColumn.Rows("6:40")
    End With
    Dim drOffset As Long: drOffset = srg.Rows.Count   1
    
    Application.ScreenUpdating = False
    ' Prevent the formulas from the copied source ranges being calculated.
    Application.Calculation = xlCalculationManual
    
    ' Loop through the cells of the source column range.
    Dim scCell As Range
    For Each scCell In scrg.Cells
        dCell.Offset(1, 3).Value = scCell.Value ' this value is what the...
        srg.Copy dCell.Offset(2) ' ... formula-infested source range depends on
        Set dCell = dCell.Offset(drOffset) ' reference the next last cell
    Next scCell
    
    ' It may take a while after turning on calculation.
    Application.Calculation = xlCalculationAutomatic
    
    ' Replace the formulas with values.
    Set drg = dws.Range(dCell, dws.Cells(6, dws.Columns.Count).End(xlToLeft))
    drg.Copy
    drg.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    Application.CutCopyMode = False
    
    ' A Final Touch
    dws.Range("A2").Select
    
    Application.ScreenUpdating = True

    MsgBox "Data generated.", vbInformation

End Sub

How to avoid Select

How to avoid `Select`