Your code doesn't look that resource intensive.

But you do have a lot of selects in there. You can copy|Paste directly with
something like:


Option Explicit

Sub Build_Summary2()
'Now build summary sheet by copying in all the workstream sheets

Dim mySheetNames As Variant
Dim SummWks As Worksheet
Dim DestCell As Range
Dim RngToCopy As Range
Dim iCtr As Long

mySheetNames = Array("pmo", "bc", "csm", "otc", _
"ptp", "scm", "man", "cm", "ds")

Set SummWks = Sheets("Summary")

With SummWks
.Range("a1:bb5000").Clear
Set DestCell = .Range("a1")
End With

For iCtr = LBound(mySheetNames) To UBound(mySheetNames)
Application.StatusBar = "Processing: " _
& mySheetNames(iCtr) & " at: " & Now

With Worksheets(mySheetNames(iCtr))

If iCtr = LBound(mySheetNames) Then
.Rows(4).Copy _
Destination:=DestCell
Set DestCell = DestCell.Offset(1, 0)
End If

Set RngToCopy _
= .Range("a5", .Cells(.Rows.Count, "A").End(xlUp)).EntireRow

RngToCopy.Copy _
Destination:=DestCell

End With

With SummWks
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With

Next iCtr

Application.StatusBar = False

End Sub

But I'm not sure it will help.

(I did change one thing that shouldn't matter much. Instead of always going to
Row 2000, I went to the last row that had something in it in column A.)


Steve Barber wrote:

I wrote the following code to combine multiple sheets - it worked fine, now,
however the machine hangs and I have to restart Excel, can anyone show more a
more elegant (less resource hungry) way of achieving my aim?

Many thanks in advance

******** Code Sample **********
sub Build_Summary()
'Now build summary sheet by copying in all the workstream sheets
Sheets("Summary").Select
Range("a1:bb5000").Select
Selection.Clear

Sheets("PMO").Select
Rows("4:2000").Select
Selection.Copy
Sheets("Summary").Select
Range("a1").Select
ActiveSheet.Paste

sheetname = "BC": GoSub copysheet
sheetname = "CSM": GoSub copysheet
sheetname = "OTC": GoSub copysheet
sheetname = "PTP": GoSub copysheet
sheetname = "SCM": GoSub copysheet
sheetname = "MAN": GoSub copysheet
sheetname = "CM": GoSub copysheet
sheetname = "DS": GoSub copysheet
GoTo finished2

copysheet:
Sheets(sheetname).Select
Rows("5:2000").Select
Selection.Copy
Sheets("Summary").Select
Range("A5").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Return
finished2:
End Sub

--

Dave Peterson