Fehler 438 Objekt unterstüzt diese.....nicht

Sub Werte_uebertragen()
Dim objWb As Workbook
Dim objSh As Worksheet
Dim strFile As String
On Error GoTo ErrExit
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
.Calculation = xlCalculationManual
.Cursor = xlWait
End With
strFile = "F:\Daten\Allgem\TREA\Update Treasury_Zahlen.xls"
If Not ThisWorkbook Is ActiveWorkbook Then ThisWorkbook.Activate
Set objSh = ActiveSheet
Set objWb = Workbooks.Open(strFile)
objWb.Sheets(4).Range("N3:N4").Copy objSh.Range("B12")
ActiveCell.Offset(0, 0).Value = objWb.Range("N3")
ActiveCell.Offset(1, 0).Value = objWb.Range("N4")
objWb.Close False
ErrExit:
If Err.Number > 0 Then
MsgBox Err.Number & vbLf & Err.Description, , "Fehler"
Err.Clear
End If
Set objWb = Nothing
Set objSh = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
.Cursor = xlDefault
End With
End Sub