Copy data from another workbook to any open workbook

[Coder1215]

Hi,

I'm using XL2007 on Vista. I want to put in Personal.xlsb a code which
will copy range of data from another workbook and paste it to
activecell in any open workbook. I wrote some code but there seems to
be an error when trying to paste values("Pastespecial methow of range
class failed").

Sub Load()

Dim wbA As Workbook
Dim cellA As Range


Set wbA = Workbooks.Open(Filename:="H:\My Documents\TESTS\CALL
LIST.xls")
Windows("CALL LIST.xls").Activate
Workbooks("CALL LIST.xls").Worksheets(1).Range("A2:A20").Copy
Windows("CALL LIST.xls").Close (False)
Application.ActiveWindow.ActiveCell.Select
ActiveCell.PasteSpecial (xlPasteValues)

End Sub

Can someone advise on the solution?

thanks and regards

 

[Dave Peterson]

Sometimes opening or closing a workbook will clear the clipboard.

I'd change the order around and use something like:

Option Explicit
Sub Load()

Dim wkbkSource As Workbook
Dim DestCell As Range
Dim RngToCopy As Range
Dim wkbkSourceWasOpen As Boolean
Dim myPath As String
Dim myFileName As String

myPath = "H:\My Documents\TESTS\"
If Right(myPath, 1) <> "\" Then
myPath = myPath & "\"
End If

myFileName = "call list.xls"

'where the paste should be
Set DestCell = ActiveCell

Set wkbkSource = Nothing
On Error Resume Next
Set wkbkSource = Workbooks(myFileName)
On Error GoTo 0

wkbkSourceWasOpen = True
If wkbkSource Is Nothing Then
'not open, so open it
wkbkSourceWasOpen = False
On Error Resume Next
Set wkbkSource = Workbooks.Open(Filename:=myPath & myFileName, _
ReadOnly:=True)
On Error GoTo 0

If wkbkSource Is Nothing Then
MsgBox "Source workbook couldn't be found!"
Exit Sub
End If
End If

Set RngToCopy = wkbkSource.Worksheets(1).Range("A2:A20")

RngToCopy.Copy
DestCell.PasteSpecial Paste:=xlPasteValues

If wkbkSourceWasOpen Then
'leave it open, do nothing
Else
wkbkSource.Close savechanges:=False
End If

End Sub

Untested, but it did compile.

 

[Coder1215]

Hi Dave,

That works perfectly, thank you! The code is more sophisticated an you
even added parts to handle missing file and building up path +
filename string.

Thank you for your time and have a Happy New Year!

regards

 

[Roger Govier]

Hi

You could do it without opening the source workbook.

here is some code from Ron de Bruin's website
http://www.rondebruin.nl/copy7.htm
which I have modified to suit your case.

Sub Load()
Application.ScreenUpdating = False
On Error Resume Next
'Call the macro GetRange
GetRange "H:\My Documents\TESTS", "CALL LIST.xls", "Sheet1", "A2:A20", _
ActiveCell
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

Sub GetRange(FilePath As String, FileName As String, SheetName As String, _
SourceRange As String, DestRange As Range)
Dim Start
'Go to the destination range
Application.Goto DestRange
'Resize the DestRange to the same size as the SourceRange
Set DestRange = DestRange.Resize(Range(SourceRange).Rows.Count, _
Range(SourceRange).Columns.Count)
'Add formula links to the closed file
With DestRange
.FormulaArray = "='" & FilePath & "/[" & FileName & "]" & SheetName
_
& "'!" & SourceRange
'Wait
Start = Timer
Do While Timer < Start + 2
DoEvents
Loop

'Make values from the formulas
.Copy
.PasteSpecial xlPasteValues
.Cells(1).Select
Application.CutCopyMode = False
End With
End Sub