How to accelerate an Excel VB Macro - excel

Question

I am trying to accelerate my Excel VB Macro.
I have tried the 5 alternatives below.
But I wonder if I could shorten the execution further.
I found 2 alternatives in User Blogs which I could not get to work.
One alternative is also found in a User Blog but do not understand.
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("SourceSheet").Copy
Workbooks.Open("DestinationWorkBook.xlsm").Worksheets("DestinationSheet").Range("A1").PasteSpecial
End If
If Alternative = "Fourth" Then
' I could not get this alternative to work
Workbooks.Open("DestinationWorkBook.xlsm").Worksheets("DestinationSheet").Range("A1") = Workbooks.Open("SourceWorkBook.xls").Worksheets("SourceSheet")
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.xlsm")
Set wbIn = Application.Workbooks.Open("SourceWorkBook.xls")
With wbIn.Sheets("SourceSheet").UsedRange
wbOut.Sheets("DestinationSheet").Range("A1").Resize(.Rows.Count, .Columns.Count) = .Value
End With
SecondsElapsed = Round(Timer - StartTime, 2)
MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation
End Sub

Answer 1

Instead of using UsedRange, find the actual Last Row and Last Column and use that range. UsedRange may not be the range that you think it is :). You may want to see THIS for an explanation.
See this example (UNTESTED)
Sub Sample()
Dim wbIn As Workbook, wbOut As Workbook
Dim rSource As Range
Dim lRow As Long, LCol As Long
Dim LastCol As String
Set wbOut = Workbooks.Open("DestinationWorkBook.xlsm")
Set wbIn = Workbooks.Open("SourceWorkBook.xls")
With wbIn.Sheets("SourceSheet")
'~~> Find Last Row
lRow = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
'~~> Find Last Column
LCol = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
'~~> Column Number to Column Name
LastCol = Split(Cells(, LCol).Address, "$")(1)
'~~> This is the range you want
Set rSource = .Range("A1:" & LastCol & lRow)
'~~> Get the values across
wbOut.Sheets("DestinationSheet").Range("A1:" & LastCol & lRow).Value = _
rSource.Value
End With
End Sub