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(lastrow - firstrow, 0)).Copy
    Range("B6").PasteSpecial xlPasteValues

    i = i + 1
    Loop
End Sub


The scenario is about 25 'numericlly named' sheets (eg 4020) for which I need to first clear (this is for a rolling document updated periodically with a differing number of rows required, the determine the number of rows, then copy-pastespecial data from an unformatted mastersheet (BW TB).

Apologies for the mess it's in.  I'm in the process of breaking up the code into more sub functions for easier reading.
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