Copying and pasting specific cells between 2 workbooks

[HansDK]

Hi.
What I am currently trying to achieve is to copy specific cell values between dynamically named workbooks. I have found the following code which works to some extent, but I get formulas transferred in to the receiving workbook in stead of values.

Sub import1()
Dim sFilename As Variant
Dim wsDest As Worksheet

sFilename = Application.GetOpenFilename("Excel Files, *.xls*")
If sFilename = False Then
    MsgBox "Nothing Imported"
    Exit Sub
End If

Set wsDest = ActiveWorkbook.Worksheets("Price sheet")

Application.ScreenUpdating = False
On Error Resume Next
With Workbooks.Open(sFilename)
.Sheets("Calculation").Range("R36").Copy wsDest.Range("Y16")
.Sheets("Calculation").Range("R33").Copy wsDest.Range("Z16")
.Sheets("Calculation").Range("R32").Copy wsDest.Range("AA16")
.Sheets("Calculation").Range("L203").Copy wsDest.Range("AB16")
.Sheets("Calculation").Range("L157").Copy wsDest.Range("AO16")
.Sheets("Calculation").Range("L158").Copy wsDest.Range("AP16")
.Close False
End With
wsDest.Range("B16").Value = DateTime.Now
On Error GoTo 0
Application.ScreenUpdating = True

Set wsDest = Nothing
End Sub

I have tried using

 xlpastevalues

without luck. I have tried using

 .value

as well without luck. If anyone could help, I would be very happy.

BR

 

[upsidedownhouse]

This works fine, where cell C1 in Sheet1 contains the formula '=A1+B1'

Sheets("Sheet1").Select
Range("C1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2").Select
Range("C1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

What are you doing which is different?

 

[Alex Blakenburg]

Since you only want values, give this a try, it should also be faster

With Workbooks.Open(sFilename)
    wsDest.Range("Y16").Value = .Sheets("Calculation").Range("R36").Value
    wsDest.Range("Z16").Value = .Sheets("Calculation").Range("R33").Value
    wsDest.Range("AA16").Value = .Sheets("Calculation").Range("R32").Value
    wsDest.Range("AB16").Value = .Sheets("Calculation").Range("L203").Value
    wsDest.Range("AO16").Value = .Sheets("Calculation").Range("L157").Value
    wsDest.Range("AP16").Value = .Sheets("Calculation").Range("L158").Value
    .Close False
End With

 

[HansDK]

Since you only want values, give this a try, it should also be faster

With Workbooks.Open(sFilename)
    wsDest.Range("Y16").Value = .Sheets("Calculation").Range("R36").Value
    wsDest.Range("Z16").Value = .Sheets("Calculation").Range("R33").Value
    wsDest.Range("AA16").Value = .Sheets("Calculation").Range("R32").Value
    wsDest.Range("AB16").Value = .Sheets("Calculation").Range("L203").Value
    wsDest.Range("AO16").Value = .Sheets("Calculation").Range("L157").Value
    wsDest.Range("AP16").Value = .Sheets("Calculation").Range("L158").Value
    .Close False
End With

Hi Alex. Perhaps it wasn't very clear from my initial posting but I did try this approach. It also did not work. To me, it should work. However, could it be something with the designation of workbooks? Could excel get confused about which is the Active workbook I am referring to ?

 

[HansDK]

Okay, so I figured it out. I am not sure why this is necessary, but here is the working code:

Sub import1()
Dim sFilename As Variant
Dim wsDest As Worksheet

sFilename = Application.GetOpenFilename("Excel Files, *.xls*")
If sFilename = False Then
    MsgBox "Nothing Imported"
    Exit Sub
End If

Set wsDest = ActiveWorkbook.Worksheets("Price sheet")

Application.ScreenUpdating = False
On Error Resume Next

wsDest.Range("Y16") = Workbooks.Open(sFilename).Sheets("Calculation").Range("R36")
wsDest.Range("Z16") = Workbooks.Open(sFilename).Sheets("Calculation").Range("R33")
wsDest.Range("AA16") = Workbooks.Open(sFilename).Sheets("Calculation").Range("R32")
wsDest.Range("AB16") = Workbooks.Open(sFilename).Sheets("Calculation").Range("L203")
wsDest.Range("AO16") = Workbooks.Open(sFilename).Sheets("Calculation").Range("L157")
wsDest.Range("AP16") = Workbooks.Open(sFilename).Sheets("Calculation").Range("L158")

Workbooks.Open(sFilename).Close False

wsDest.Range("B16").Value = DateTime.Now
On Error GoTo 0
Application.ScreenUpdating = True

Set wsDest = Nothing
End Sub