Managing book of Excel sheets

This is a follow-on from a previous question I posted here.

I've got code here that works for what I want, but the problem is the loop takes ages to perform. I was wondering if anyone could follow this and tidy it up a bit for me.

```
Sub Refresh_Data()
Application.CutCopyMode = False

'Turns screen updating off to increase speed
Application.ScreenUpdating = False

'Get 'G/L Account numbers
Sheet1 = "BW TB"

Sheets(Sheet1).Activate
Range("A1").Activate

'Find last row - always named "Overall Result" in ColA
Cells.Find(What:="Overall Result", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
True, SearchFormat:=False).Activate

'This looks up to row 25 (title row), but adjusts to only copy data from row 26 down to the penultimate row (the subtotal is not required)
lastrow = Selection.Row - 1
colno = Selection.Column
firstrow = Selection.End(xlUp).Row + 1

'CopyPaste loop

'First sheet is titled "4020"
i = Sheets("4020").Index

'Due to all the sheet names being numeric. This is a slight workaround.
'It basically runs the macro starting at the 4020 sheet and ending at the last sheet with a numeric sheets.
'i.e. pastes values for all numbered tabs.
Do While IsNumeric(Sheets(i).Name) = True

'clear all formulae except first formulaic row (Row5)
Sheets(i).Activate
Range("A6").EntireRow.Select
Range(Selection, Selection.Offset(1000, 0)).ClearContents

'Copy G/L Account numbers from BW TB sheet to current sheet
Sheets(BWTB).Activate
Range(Cells(firstrow, colno), Cells(lastrow, colno)).Copy

Sheets(i).Activate
Range("a5").PasteSpecial xlPasteValues

'Copy down formulae
Range("B5:L5").Copy
Range("B5:L5", Range("B5:L5").Offset(lastrow - firstrow, 0)).PasteSpecial xlPasteFormulas

ActiveSheet.Calculate

'Paste As Values
Range("B6:L6", Range("B6:L6").Offset(l

You should clean up every Select and Activate and use objects instead

You'd better use the object model of VBA.

For instance, if you only want to copy the value of a cell:

Don't do

Range("A1").Select
Selection.Copy
Range("A2").Select
Selection.Paste

Do

Range("A2").Value = Range("A1").Value

Another example:

Don't do

Cells.Find(...).Activate
lastrow = Selection.Row - 1
colno = Selection.Column
firstrow = Selection.End(xlUp).Row + 1

Do

Dim mycell as Range
Set cell = Cells.Find(...)
lastrow = mycell .Row - 1
colno = mycell .Column
firstrow = mycell .End(xlUp).Row + 1

And so on, especially on your Sheet objects.

Example to copy-paste between sheets

You only have to adapt this kind of statement to your specific case:

Worksheets("Sheet1").Range("A1").Copy
Worksheets("Sheet2").Range("A2").PasteSpecial xlPasteFormulas

Other tips

You can also have a look at the very good website of Chip Pearson

Edit

Instead of:

Sheets(i).Activate
Range("A6").EntireRow.Select
Range(Selection, Selection.Offset(1000, 0)).ClearContents

You can try:

Dim lastCol as Long
With Sheets(i)
    lastCol = .Cells(6, .Columns.Count).End(xlToLeft).Column
    .Range("A6", .Cells(1000, lastCol)).ClearContents
End With

This will find the last column where you have data (so that you don't have to clear contents of the entire row) on the 6th row and then it will clear the content of the Range between A6 and the last column and the 1000th row.

Another edit

You also have a minor issue in your declaration part.

This:

Dim mycell As Range, LastRow, ColNo, FirstRow, i As Integer

doesn't work, you have to do:

Dim mycell As Range, LastRow As Integer, ColNo As Integer, FirstRow As Integer, i As Integer

StackExchange Code Review Q#6823, answer score: 7