ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Discussion (Misc queries) (https://www.excelbanter.com/excel-discussion-misc-queries/)
-   -   Paste Link to data Help!!! (https://www.excelbanter.com/excel-discussion-misc-queries/251003-paste-link-data-help.html)

PhilosophersSage

Paste Link to data Help!!!
 
J_Knowles helped me out with this macro; it is very useful for transferring
data from one workbook to another and has been very helpful for the short
term; however, I still need to create a link to the data as some people who
use the destination data file do not have access to both files and cannot run
the macro.

http://www.microsoft.com/office/comm...8-75c6f3091b9f

Sub FindMatchesInBooks()
Dim swb As Workbook, dwb As Workbook
Dim sd As Worksheet, dd As Worksheet
Dim cell As Range, x As Long
Dim LastRowS As Long, LastRowD As Long
Application.ScreenUpdating = False
Set swb = Workbooks("source.xlsm") ' change to source data filename
Set dwb = Workbooks("destination.xlsx") ' change to destination data
filename
swb.Activate
Set sd = Worksheets("Sheet 5") 'Source worksheet
sd.Activate
LastRowS = Cells(Cells.Rows.Count, "L").End(xlUp).Row
Set rngS = Range("L2:L" & LastRowS)
dwb.Activate
Set dd = Worksheets("Sheet 3") ' Destination worksheet
dd.Activate
LastRowD = Cells(Cells.Rows.Count, "B").End(xlUp).Row
For x = 2 To LastRowD
For Each cell In rngS
If dd.Cells(x, 2).Value = cell.Value Then
dd.Cells(x, 14).Formula = cell.Offset(0, -4).Value 'Sets column
N source to column H
dd.Cells(x, 15).Formula = cell.Offset(0, -2).Value 'Sets Column
O source to column J
dd.Cells(x, 16).Formula = cell.Offset(0, -1).Value 'Sets Column
P source to column K
End If
Next
Next x
Application.ScreenUpdating = True
MsgBox "All Connections and Ring-out information has been updated."
End Sub




All times are GMT +1. The time now is 05:25 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com