Need to Speed Up A Code

L

LostInNY

I am using the following code for 10 sheets in the same workbook. It works,
but it takes about 4 minutes to run. The 10 spreadsheets contain formulas
which I do not want in the final version. I am performing an advance filter
on each sheet and copying this info to another spreadsheet and copying back
values only to the original spreadsheet. Effective, but very time consuming.
I am using Excel 2003.


Sheets("sheet1").Select
Range("A1:D3000").AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Rows("1:3001").Select
Selection.Copy
Sheets("CopyWorkSheet").Select
Cells.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=True, Transpose:=False
Sheets("Sheet1").Select
Application.CutCopyMode = False
On Error Resume Next
ActiveSheet.ShowAllData
On Error GoTo 0
Sheets("CopyWorkSheet").Select
Cells.Select
Selection.Copy
Sheets("sheet1").Select
 
P

Per Jessen

Hi

I think this is what you need. I suspect you want to delete data from
Sheet1 before you paste the unique data, though I cant see it from
your code snippet. If that is the case it should be done before the
line: shB.Cells.Copy Destination:=shA.Range("A1")



Sub foo()
Dim shA As Worksheet
Dim shB As Worksheet
Application.ScreenUpdating = False
Set shB = Worksheets("CopyWorkSheet")
For Each shA In ThisWorkbook.Worksheets
If shA.Name <> shB.Name Then
Set shA = Worksheets("sheet1")
With shA
.Range("A1:D3000").AdvancedFilter _
Action:=xlFilterInPlace, Unique:=True
.Rows("1:3001").Copy
End With

shB.Range("A1").PasteSpecial Paste:= _
xlPasteValues, Operation:=xlNone, SkipBlanks _
:=True, Transpose:=False
Application.CutCopyMode = False
On Error Resume Next
shA.ShowAllData
On Error GoTo 0
shB.Cells.Copy Destination:=shA.Range("A1")
End If
Next
Application.ScreenUpdating = True
End Sub

Hopes this helps.
....
Per
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top