Originally Posted by

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function


Function bIsBookOpen(ByRef szBookName As String) As Boolean
On Error Resume Next
bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function

Sub copy_to_another_workbook()
Dim sourceRange As Range
Dim destrange As Range
Dim destWB As Workbook
Dim smallrng As Range
Dim I As Integer
Dim lr As Long

Application.ScreenUpdating = False
If bIsBookOpen("test.xls") Then
Set destWB = Workbooks("test.xls")
Else
Set destWB = Workbooks.Open("h:\test.xls")
End If

I = 1
lr = LastRow(destWB.Worksheets("Sheet1")) + 1
For Each smallrng In ThisWorkbook.Worksheets("Sheet1"). _
Range("B1:B1, B5:B5, E2:E2, B2:B2, K2:K2").Areas

Set destrange = destWB.Worksheets("Sheet1").Cells(lr, I)
smallrng.Copy
destrange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
I = I + smallrng.Rows.Count
Next smallrng
destWB.Close True
Application.ScreenUpdating = True
End Sub


There is the code. What it is supposed to do is take data from Cells
B1, B5, E2, etc. from an embedded worksheet in a word document an place
it in seperate excel file called test.xls. The macro works fine from
excel to excel but not as as embedded object in Word.