View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
[email protected] azu_daioh@yahoo.com is offline
external usenet poster
 
Posts: 28
Default How to copy rows from 1 workbook to another workbook

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