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

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

UPDATE Code below updated for improvements thus far. I think this part:

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

still needs refining; I've tried a few of the suggestions below but either get errors I can't correct, or it doesnt perform the same task as the above.

This is a follow-on from a previous question I posted here: http://stackoverflow.com/questions/8403069/looking-to-select-an-undetermined-number-of-rows-in-excel-as-part-of-larger-vba

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

Option Explicit
Sub Refresh_Data()
Application.CutCopyMode = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim BWTB As String
BWTB = "BW TB"
Worksheets(BWTB).Activate
Range("A1").Activate
Dim mycell As Range, LastRow, ColNo, FirstRow, i As Integer

Set mycell = Cells.Find(What:="Overall Result", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
True, SearchFormat:=False)
LastRow = mycell.Row - 1
ColNo = mycell.Column
FirstRow = mycell.End(xlUp).Row + 1
i = Sheets("4020").Index
Do While IsNumeric(Sheets(i).Name) = True
 
 Sheets(i).Activate
 Range("A6").EntireRow.Select
 Range(Selection, Selection.Offset(1000, 0)).ClearContents
 With Worksheets(BWTB)
 Range(.Cells(FirstRow, ColNo), .Cells(LastRow, ColNo)).Copy
 End With
 Worksheets(i).Range("A5").PasteSpecial xlPasteValues
 
 Range("B5:L5").Copy
 Range("B5:L5", Range("B5:L5").Offset(LastRow - FirstRow, 0)).PasteSpecial xlPasteFormulas
 
 ActiveSheet.Calculate
 
 Range("B6:L6", Range("B6:L6").Offset(LastRow - FirstRow, 0)).Copy
 Range("B6").PasteSpecial xlPasteValues
 i = i + 1
Loop

Application.ScreenUpdating = True
End Sub

Apologies for the mess it's in I'm in the process of breaking up the code into more sub functions for easier reading.

any help as always much appreciated :)

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

Apologies for the mess it's in. I'm in the process of breaking up the code into more sub functions for easier reading.

*UPDATE: Code below updated for improvements thus far.

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

still needs refining; I've tried a few of the suggestions below but either get errors I can't correct, or it doesnt perform the same task as the above.*

UPDATE Code below updated for improvements thus far. I think this part:

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

still needs refining; I've tried a few of the suggestions below but either get errors I can't correct, or it doesnt perform the same task as the above.