How to copy rows from 1 workbook to another workbook

[azu_daioh]

I couldnt locate any code that will accomplish this.

Here's what I need:
wbPRIMARY.xls = the workbook where I want the range (A49-H52) to copy
from
wbSECONDARY.xls = the workbbok where I want the range to copy to


in wbSECONDARY.xls == i have a worksheet by employees name. ie.
Davidson
in wbPRIMARY.xls == i have worksheets by office locations related to
Davidson, ie. 205, 206

I want to be able to search through wbPRIMARY and any worksheets that
is related to Davidson, I want the range (A49-H52) to be copied and
pasted onto "Davidson" worksheet in wbSECONDARY.

in wbSECONDARY.xls == i have a worksheet that asks for the name and
office locations
Name:
B2 Davidson

Office Location(s):
B4 205
B5 208
B6 219
up to B13

If anyone could help me out start this, I appreciate it. Thank you

 

[azu_daioh]

I found this code and modified it...but the code keeps giving me an
error 9 message and each time I hit debug, this line is highlighted:

Set SourceRange = SourceWB.Sheets(x).Range("A49:H51")


---------

Private Sub copyMyDailyRows_Click()
Dim SourceRange As Range
Dim DestRange As Range
Dim SourceWB As Workbook
Dim SourceSh As Worksheet
Dim DestShName As String
Dim DestSh As Worksheet
Dim Lr As Long

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Dim nWS As Integer
Dim x As String
Dim y As Integer
Dim z As Integer

nWS = Me.Range("howMany").Value

'Source workbook
If bIsBookOpen_RB("wsPRIMARY.xls") Then
Set SourceWB = Workbooks("wsPRIMARY.xls")
Else
Set SourceWB = Workbooks.Open(ActiveWorkbook.Path &
"\wsPRIMARY.xls")
End If

z = 6 + nWS - 1

For y = 6 To z
Workbooks("wsSECONDARY.xls").Activate

x = ActiveWorkbook.Sheets(1).Cells(y, 2).Value

'Source range

Set SourceRange = SourceWB.Sheets(x).Range("A49:H51")

'Destination sheet
DestShName = Me.Range("whatmyName").Value
Set DestSh = ActiveWorkbook.Worksheets(DestShName)

Lr = LastRow(DestSh)
Set DestRange = DestSh.Range("A" & Lr + 3)

DestSh.Range("A" & Lr + 2).Value = x

'We make DestRange the same size as SourceRange and use the
Value
'property to give DestRange the same values
With SourceRange
Set DestRange =
DestRange.Resize(.Rows.Count, .Columns.Count)
End With

'DestRange.Value = SourceRange.Value
SourceRange.COPY
DestRange.PasteSpecial

Dim DestRange1 As Range
Dim r As Range

Set DestRange1 = DestRange.EntireRow.SpecialCells(xlFormulas)
Set r = DestRange1.Parent.Cells("50", DestRange1(1).Column)
DestRange1.Formula = "='[wsPRIMARY.xls]" & x & "'!" &
r.Address(0, 0)


Next y
SourceWB.Close savechanges:=True

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub


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

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 LastCol(sh As Worksheet)
On Error Resume Next
LastCol = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
End Function

 

[azu_daioh]

NVM. I got it to work when I added to auto update the links.