I am trying to accelerate my Excel VB Macro significantly. I have tried the 5 alternatives below. I wonder if I could shorten the execution time further.


Sub AccelerateMacro()
'
' v1 052817 by eb+mb


' Macro to copy as fast as possible sheet from one workbook into another workbooks
' Declarations for variables are not shown to make code example more legible
' Macro is stored in and run from "DestinationWorkBook.xlsm"
StartTime = Timer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Alternative = "First"
If Alternative = "First" Then
Workbooks.Open Filename:="SourceWorkBook.xls"
Cells.Select
Selection.Copy
Windows("DestinationWorkBook.xlsm").Activate
Sheets("DestinationSheet").Select
Range("A1").Select
ActiveSheet.Paste
Windows("SourceWorkBook.xls").Activate
ActiveWorkbook.Close
End If
If Alternative = "Second" Then
Workbooks.Open Filename:="SourceWorkBook.xls", ReadOnly:=True
Cells.Select
Selection.Copy
Windows("DestinationWorkBook.xlsm").Activate
Sheets("DestinationSheet").Select
Range("A1").Select
ActiveSheet.Paste
Workbooks("SourceWorkBook.xls").Close SaveChanges:=False
End If
If Alternative = "Third" Then
' I could not get this alternative to work
Workbooks.Open("SourceWorkBook.xls").Worksheets("S ourceSheet").Copy
Workbooks.Open("DestinationWorkBook.xlsm").Workshe ets("DestinationSheet").Range("A1").PasteSpecial
End If
If Alternative = "Fourth" Then
' I could not get this alternative to work
Workbooks.Open("DestinationWorkBook.xlsm").Workshe ets("DestinationSheet").Range("A1") = Workbooks.Open("SourceWorkBook.xls").Worksheets("S ourceSheet")
End If
If Alternative = "Fifth" Then
' I don't understand the code in this alternative
Dim wbIn As Workbook
Dim wbOut As Workbook
Dim rSource As Range
Dim rDest As Range
Set wbOut = Application.Workbooks.Open("DestinationWorkBook.xl sm")
Set wbIn = Application.Workbooks.Open("SourceWorkBook.xls")
With wbIn.Sheets("SourceSheet").UsedRange
wbOut.Sheets("DestinationSheet").Range("A1").Resiz e(.Rows.Count, .Columns.Count) = .Value
End With

SecondsElapsed = Round(Timer - StartTime, 2)
MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation
End Sub