Hi,
I have the following code in a master spreadsheet that I am using to try and copy rows from one workbook to another workbook depending on the value in column R in the source workbook. Both workbooks are opening OK but nothing is getting copied across, any advice please?.
Thx,
John
Sub CopyToMasterArchive()
Dim WBs As Workbook
Dim WBd As Workbook
Dim WSs As Worksheet
Dim WSd As Worksheet
Dim WRSLocation As String
Dim WRSLivelist As String
Dim WRSArchive As String
Dim Sr As Long
Dim Dr As Long
Dim r As Long
WRSLocation = "\\5p6fs003\5p6p-rdf\Home First"
WRSLivelist = WRSLocation & "WRS Livelist.xlsx"
WRSArchive = WRSLocation & "WRS Master Archive.xlsx"
Set WBs = Workbooks.Open(WRSLivelist)
Set WSs = WBs.Worksheets("Summary")
Set WBd = Workbooks.Open(WRSArchive)
Set WSd = WBd.Worksheets("Data")
Sr = WSs.Cells(Rows.Count, "A").End(xlUp).Row
Dr = WSd.Cells(Rows.Count, "A").End(xlUp).Row
For r = Sr To 2 Step -1
If Range("R" & r).Value = "Y" Then
Rows(r).Copy Destination:=WSd.Range("A" & Dr + 1)
Dr = WSd.Cells(Rows.Count, "A").End(xlUp).Row
End If
Range("A1").Select
Next r
End Sub
I have the following code in a master spreadsheet that I am using to try and copy rows from one workbook to another workbook depending on the value in column R in the source workbook. Both workbooks are opening OK but nothing is getting copied across, any advice please?.
Thx,
John
Sub CopyToMasterArchive()
Dim WBs As Workbook
Dim WBd As Workbook
Dim WSs As Worksheet
Dim WSd As Worksheet
Dim WRSLocation As String
Dim WRSLivelist As String
Dim WRSArchive As String
Dim Sr As Long
Dim Dr As Long
Dim r As Long
WRSLocation = "\\5p6fs003\5p6p-rdf\Home First"
WRSLivelist = WRSLocation & "WRS Livelist.xlsx"
WRSArchive = WRSLocation & "WRS Master Archive.xlsx"
Set WBs = Workbooks.Open(WRSLivelist)
Set WSs = WBs.Worksheets("Summary")
Set WBd = Workbooks.Open(WRSArchive)
Set WSd = WBd.Worksheets("Data")
Sr = WSs.Cells(Rows.Count, "A").End(xlUp).Row
Dr = WSd.Cells(Rows.Count, "A").End(xlUp).Row
For r = Sr To 2 Step -1
If Range("R" & r).Value = "Y" Then
Rows(r).Copy Destination:=WSd.Range("A" & Dr + 1)
Dr = WSd.Cells(Rows.Count, "A").End(xlUp).Row
End If
Range("A1").Select
Next r
End Sub