Slow running Macro and Avoiding Select when pasting between Excel sheets - excel

Question

I have an Excel sheet which looks at performance figures for a rolling 5 week period. I created a macro which copies the data from week 4 to week 5 and repeats for each work sheet before leaving week 1 empty so I can paste in the most recent data.
The macro is slow and seems to get slower every week. To try to make it faster I put in code to clear the existing contents before pasting in the new data. This worked at first, but it has slowed again.
This is the code for the first two sheets to be copied. It does the same for the rest of the sheets but the code is the same.
Sub Move_data() ' Copies all data across to advance sheet by one week.
Application.ScreenUpdating = False
Sheets("Week 5").Select ' Clears current entry from week 5
Range("A1:S161").Select
Application.CutCopyMode = False
Selection.ClearContents
Sheets("Week 4").Select 'Selects data to copy from week 4
Range("A1:S161").Select
Selection.Copy
Sheets("Week 5").Select 'Pastes data to week 5
Range("A1").Select
ActiveSheet.Paste
Sheets("Week 4").Select 'Clears data from week 4
Application.CutCopyMode = False
Selection.ClearContents
Sheets("Week 3").Select 'Selects data to copy from week 3
Range("A1:S161").Select
Selection.Copy
Sheets("Week 4").Select 'Pastes data to week 4
Range("A1").Select
ActiveSheet.Paste
Having looked at various articles I think that part of the problem lies in using ".Select" so frequently.
I tried to replace these two lines:
Range("A1:S161").Select
Selection.Copy
with
Range("AR:S161").Copy
It didn't seem to have much impact on the time it takes for the macro to run.
How could this code work more efficiently?

Answer 1

If you are only interested in moving the values from one sheet to another then Value Transfer is ideal solution since it's more efficient than copy/paste. However, if you also need to copy formulas from one sheet to the next then you will need to switch to Copy/Paste.
Sub Mover()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim i As Long
For i = 5 To 1 Step -1
wb.Sheets("Week " & i).Range("A1:S161").ClearContents
If i <> 1 Then
wb.Sheets("Week " & i - 1).Range("A1:S161").Copy
wb.Sheets("Week " & i).Range("A1").PasteSpecial xlPasteAll
End If
Next i
End Sub

Answer 2

Try this:
Sub Move_data() ' Copies all data across to advance sheet by one week.
Const RNG As String = "A1:S161"
Dim n As Long
For n = 5 to 2 step - 1
Sheets("Weeek " & n).Range(RNG).Value = Sheets("Weeek " & (n-1)).Range(RNG).Value
Next n
End Sub
Assigning values directly is often faster.