Hi all,

I have a macro that copies 4 cells (the input) and pastes into another different 4 cells (these are always the same cells), and because each cell contains a formula, the value is now copied onto another 4 cells (the output). This action needs to be repeated for about 400 (rows) times and at the moment it takes about 30min to run

Therefore, I would like to ask for you help if you know any way to speed it up the macro. I am aware that the "select" action is a waste of time but I cannot come up with any other way to develop the macro.

Please find the code below:


Sub Calculation()

Application.ScreenUpdating = False
ActiveSheet.DisplayPageBreaks = False

Dim i As Integer

   i = 1

Range("A6").Select

While (Selection.Value) <> 0

Selection.Copy

Range("AQ1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Selection.Offset(4 + i, -40).Copy
    Range("AS1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Selection.Offset(4 + i, -7).Copy
    Range("AM2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
Selection.Offset(3 + i, 0).Copy
    Range("AO2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Selection.Offset(3 + i, -1).Copy
    Range("AM3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
Selection.Offset(2 + i, 2).Copy
    Range("AO3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
Range("AQ2").Select
    Selection.Copy
    Selection.Offset(3 + i, -1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Range("AS2").Select
    Selection.Copy
    Selection.Offset(3 + i, -2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
Range("AQ3").Select
    Selection.Copy
    Selection.Offset(2 + i, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
Range("AS3").Select
    Selection.Copy
    Selection.Offset(2 + i, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Selection.Offset(1, -44).Select

i = i + 1

Wend

Application.ScreenUpdating = True
ActiveSheet.DisplayPageBreaks = True


End Sub


Many thanks in advance for you help.