Making the copy paste process run faster - performance

Question

Sub test()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
Dim x As Workbook
Dim y As Workbook
Set x = ActiveWorkbook
Set y = Workbooks.Open("S:\HR\Attendance Charts\2014\May 14\abc.xlsx")
y.Sheets("Report").Activate
ActiveSheet.Range("A34:DM64").Copy
x.Sheets("Modified").Activate
ActiveSheet.Range("A70").PasteSpecial xlPasteValues
y.Close
End Sub
I am using this code to copy some data from x workbook to y workbook. Size of x workbook is 13 MB and the Y is 23.5 MB. Copying the data from x and pasting it to y takes a lot of time. Is there anyway I can make this process run faster? I am using the code above. Thanks

Answer 1

According to http://www.ozgrid.com/VBA/SpeedingUpVBACode.htm , the following may make your code faster (it bypasses the clipboard and copies the values directly):
Sub test()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
Dim x As Workbook
Dim y As Workbook
Dim r1 As Range ' source
Dim r2 As Range ' destination
Set x = ActiveWorkbook
Set y = Workbooks.Open("S:\HR\Attendance Charts\2014\May 14\abc.xlsx")
Set r1 = y.Sheets("Report").Range("A34:DM64")
Set r2 = x.Sheets("Modified").Range("A70:DM100")
r2.Value = r1.Value '<<<<<<<<< this is the line that does the magic
y.Close
End Sub
Do check that I set the ranges r1 and r2 correctly...

Answer 2

i changed Floris's code a bit, to try with a VBA Array
Sub test()
with Application
.ScreenUpdating = False
.DisplayAlerts = False
.AskToUpdateLinks = False
.enableevents=false
.calculation = Xlmanual
end with
Dim x As Workbook
Dim y As Workbook
Dim r1 As Range ' source
Dim r2 As Range ' destination
Dim Y_Array() as Variant
dim Y_Sheet as Worksheet
Dim X_Sheet as Worksheet
Set x = ActiveWorkbook
Set X_Sheet= x.Sheets("Modified") '=activesheet ' i've preferably named it with complete name here
'testing if y already opened, if it's the case win a lot of time
err.clear
on error resume next
Set y = Workbooks ("abc.xlsx")
if err<>0 then
err.clear
Set y = Workbooks.Open("S:\HR\Attendance Charts\2014\May 14\abc.xlsx")
end if
on error goto 0
with y
application.windows(.name).windowstate=xlminimized
set Y_Sheet= .Sheets("Report")
with Y_Sheet
Set r1 = .Range(.cells(34,1) , .cells(64,117) ) ' same as "A34:DM64")
with r1
redim Y_Array (1 to 30, 1 to 117) 'to make it a dynamic array : (1 to .rows.count, 1 to .columns.count)
Y_Array = .value2 'edit : modified to .value2
end with
end with
end with
Set r2 = x.Sheets("Modified").Range("A70:DM100")
r2.Value2 = Y_Array 'r1.Value '<<<<<<<<< this is the line that does the magic 'edit: modified to value2
y.Close
'Free memory
erase Y_Array
set r1=nothing
set Y_Sheet=nothing
set Y=nothing
set r2=nothing
set X_Sheet=nothing
set X=nothing
with Application
.ScreenUpdating = true 'uh, without reseting it to normal you gonna have troubles....
.DisplayAlerts = true
'.AskToUpdateLinks = true
.enableevents = true
.calculation = XlAutomatic
end with
End Sub
Code untested, not sure it really helps, give it a try...