Try This Approach ...
Option Explicit
Private Sub Juke_XL_F2_And_BLP()
On Error GoTo eh:
Dim wbName As String
Dim wsName As String
Dim tgt As Worksheet
Dim rng As Range
Dim cell As Range
Dim myString As String
Dim lastRow As Long
Dim lastColumnIndex As Long
Dim lastColumnString As String
wbName = ThisWorkbook.Name
wsName = Workbooks(wbName).ActiveSheet.Name
Set tgt = Workbooks(wbName).Worksheets(wsName)
With tgt
'
'Parameterize the range of interest ...
'
lastRow = FindLastRow
lastColumnIndex = FindLastColumnIndex
lastColumnString = FindLastColumnString
'
'Option A: Finesse the Excel / {F2}{Enter} / BLP cross dependency ...
'
' Start in column D as I want to preserve the formulas in
' columns A and B; use columnIndex = 4 in the formulas below.
'
' Try ...
' Courtesy of ...
http://www.ozgrid.com/VBA/SpeedingUpVBACode.htm
'
' Everything:
' Sheet1.Range("A1:A200").Copy Destination:=Sheet2.Range("B1")
'
' Values Only:
' Sheet2.Range("B1:B200").Value = Sheet1.Range("A1:A200").Value
'
' Formulas Only:
' Sheet2.Range("B1:B200").Formula = Sheet1.Range("A1:A200").Formula
'
'Juking the Excel / {F2}{Enter} / BLP interface here ...
'
'tgt.Range(Cells(1, 4), Cells(lastRow, lastColumnIndex)).Value = _
tgt.Range(Cells(1, 4), Cells(lastRow, lastColumnIndex)).Value
'Application.CalculateFull
'
'Option B: Finesse the Excel / {F2}{Enter} / BLP cross dependency ...
' Start in column D as I want to preserve the formulas in
' columns A and B; use columnIndex = 4 in the formulas below.
'
Set rng = Range(Cells(1, 4), Cells(lastRow, lastColumnIndex))
For Each cell In rng
'Range value our string formulas ...
cell.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
'Clear the clipboard ...
Application.CutCopyMode = False
'Juking the Excel / {F2}{Enter} / BLP interface here ...
myString = Selection
Selection = myString
Next cell
Application.CalculateFull
'
'In case, you're wondering, the SendKeys approach did not work for me
'
'avoidloop = True
'Application.SendKeys "{F2}", True
'Application.SendKeys "{ENTER}", True
End With
Exit Sub
eh: If Err Then MsgBox "Err[" & Err.Number & "]: " & Err.Description & ".", vbAbortRetryIgnore, "Error Handler": Resume Next
End Sub
Function FindLastRow() As Long
On Error GoTo eh:
Dim theRow As Long
If WorksheetFunction.CountA(Cells) > 0 Then
'Search for any entry, by searching backwards by Rows.
theRow = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
'MsgBox theRow
End If
FindLastRow = theRow
Exit Function
eh: If Err Then MsgBox "Err[" & Err.Number & "]: " & Err.Description & ".", vbAbortRetryIgnore, "Error Handler": Resume Next
End Function
Function FindLastColumnString() As String
On Error GoTo eh:
Dim theColumnIndex As Integer
Dim theColumnString As String
Dim rng As Range
Dim address As String
Dim index As Integer
If WorksheetFunction.CountA(Cells) > 0 Then
'Search for any entry, by searching backwards by Columns.
theColumnIndex = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
'MsgBox theColumn
End If
Set rng = Range(Cells(1, theColumnIndex), Cells(1, theColumnIndex))
address = rng.address(1, 0)
index = InStr(1, address, "$", vbTextCompare)
theColumnString = Left(address, index - 1)
FindLastColumnString = theColumnString
Exit Function
eh: If Err Then MsgBox "Err[" & Err.Number & "]: " & Err.Description & ".", vbAbortRetryIgnore, "Error Handler": Resume Next
End Function
Function FindLastColumnIndex() As Long
On Error GoTo eh:
Dim theColumnIndex As Integer
Dim theColumnString As String
Dim rng As Range
Dim address As String
Dim index As Integer
If WorksheetFunction.CountA(Cells) > 0 Then
'Search for any entry, by searching backwards by Columns.
theColumnIndex = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
'MsgBox theColumn
End If
Set rng = Range(Cells(1, theColumnIndex), Cells(1, theColumnIndex))
address = rng.address(1, 0)
index = InStr(1, address, "$", vbTextCompare)
theColumnString = Left(address, index - 1)
FindLastColumnIndex = theColumnIndex
Exit Function
eh: If Err Then MsgBox "Err[" & Err.Number & "]: " & Err.Description & ".", vbAbortRetryIgnore, "Error Handler": Resume Next
End Function
