Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy and Paste link between workbooks
I have several workbooks, source data (SD) and destination data (DD) which
are portions of SD, I would like to make a macro that would search for matching values between SD column L & DD column B and if there is a match copy a link from SD column H, J & K to DD column N, O & P this way I can reduce entry points for data. The big problem I have is the search between workbooks, also I cannot get the paste function to give a link between workbooks. Any help or pointers anyone can give me I would really appreciate it! Thank you! |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy and Paste link between workbooks
Still cannot figure out search and compare function but was able to figure
out copy link function. Just cannnot get the varables to work. I tried adding a varable to the code but then it would not work. any pointers on search and varable help is much appreciate, thank you! Windows("source data.xlsm").Activate Range("H266").Select 'would like to change to Range("H"&RowVar1) Selection.Copy Windows("Destination data.xlsx").Activate Range("N45").Select 'would like to change to Range("N"&RowVar2) ActiveSheet.Paste Link:=True Windows("source data.xlsm").Activate Range("J266").Select 'would like to change to Range("H"&RowVar1) Application.CutCopyMode = False Selection.Copy Windows("Destination data.xlsx").Activate Range("O45").Select' would like to change to Range("N"&RowVar2) ActiveSheet.Paste Link:=True Windows("source data.xlsm").Activate Range("K266").Select 'would like to change to Range("H"&RowVar1) Application.CutCopyMode = False Selection.Copy Windows("Destination data.xlsx").Activate Range("P45").Select 'would like to change to Range("N"&RowVar2) ActiveSheet.Paste Link:=True "PhilosophersSage" wrote: I have several workbooks, source data (SD) and destination data (DD) which are portions of SD, I would like to make a macro that would search for matching values between SD column L & DD column B and if there is a match copy a link from SD column H, J & K to DD column N, O & P this way I can reduce entry points for data. The big problem I have is the search between workbooks, also I cannot get the paste function to give a link between workbooks. Any help or pointers anyone can give me I would really appreciate it! Thank you! |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy and Paste link between workbooks
Ok figured out what I did wrong... had file names wrong in varable so the
code now works. Please help with searching wkbk1 data column L using data in wkbk2 column B as search peramater and return row number to RowVar1. Windows(wkbk1).Activate Range("H" & RowVar1).Select Selection.Copy Windows(wkbk2).Activate Range("N" & RowVar2).Select ActiveSheet.Paste Link:=True Windows(wkbk1).Activate Range("J" & RowVar1).Select Application.CutCopyMode = False Selection.Copy Windows(wkbk2).Activate Range("O" & RowVar2).Select ActiveSheet.Paste Link:=True Windows(wkbk1).Activate Range("K" & RowVar1).Select Application.CutCopyMode = False Selection.Copy Windows(wkbk2).Activate Range("P" & RowVar2).Select ActiveSheet.Paste Link:=True "PhilosophersSage" wrote: Still cannot figure out search and compare function but was able to figure out copy link function. Just cannnot get the varables to work. I tried adding a varable to the code but then it would not work. any pointers on search and varable help is much appreciate, thank you! Windows("source data.xlsm").Activate Range("H266").Select 'would like to change to Range("H"&RowVar1) Selection.Copy Windows("Destination data.xlsx").Activate Range("N45").Select 'would like to change to Range("N"&RowVar2) ActiveSheet.Paste Link:=True Windows("source data.xlsm").Activate Range("J266").Select 'would like to change to Range("H"&RowVar1) Application.CutCopyMode = False Selection.Copy Windows("Destination data.xlsx").Activate Range("O45").Select' would like to change to Range("N"&RowVar2) ActiveSheet.Paste Link:=True Windows("source data.xlsm").Activate Range("K266").Select 'would like to change to Range("H"&RowVar1) Application.CutCopyMode = False Selection.Copy Windows("Destination data.xlsx").Activate Range("P45").Select 'would like to change to Range("N"&RowVar2) ActiveSheet.Paste Link:=True "PhilosophersSage" wrote: I have several workbooks, source data (SD) and destination data (DD) which are portions of SD, I would like to make a macro that would search for matching values between SD column L & DD column B and if there is a match copy a link from SD column H, J & K to DD column N, O & P this way I can reduce entry points for data. The big problem I have is the search between workbooks, also I cannot get the paste function to give a link between workbooks. Any help or pointers anyone can give me I would really appreciate it! Thank you! |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy and Paste link between workbooks
You do not have to use copy & paste.
First worksheet name = source Second worksheet name = destination See if this will work. Sub FindMatches() Dim sd As Worksheet Dim dd As Worksheet Dim cell As Range Dim x As Long Dim LastRowS As Long Dim LastRowD As Long Set sd = Worksheets("source") Set dd = Worksheets("destination") sd.Activate LastRowS = Cells(Cells.Rows.Count, "L").End(xlUp).Row Set rngS = Range("L2:L" & LastRowS) 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 dd.Cells(x, 15).Formula = cell.Offset(0, -2).Value dd.Cells(x, 16).Formula = cell.Offset(0, -1).Value End If Next Next x End Sub HTH -- Data Hog "PhilosophersSage" wrote: Ok figured out what I did wrong... had file names wrong in varable so the code now works. Please help with searching wkbk1 data column L using data in wkbk2 column B as search peramater and return row number to RowVar1. Windows(wkbk1).Activate Range("H" & RowVar1).Select Selection.Copy Windows(wkbk2).Activate Range("N" & RowVar2).Select ActiveSheet.Paste Link:=True Windows(wkbk1).Activate Range("J" & RowVar1).Select Application.CutCopyMode = False Selection.Copy Windows(wkbk2).Activate Range("O" & RowVar2).Select ActiveSheet.Paste Link:=True Windows(wkbk1).Activate Range("K" & RowVar1).Select Application.CutCopyMode = False Selection.Copy Windows(wkbk2).Activate Range("P" & RowVar2).Select ActiveSheet.Paste Link:=True "PhilosophersSage" wrote: Still cannot figure out search and compare function but was able to figure out copy link function. Just cannnot get the varables to work. I tried adding a varable to the code but then it would not work. any pointers on search and varable help is much appreciate, thank you! Windows("source data.xlsm").Activate Range("H266").Select 'would like to change to Range("H"&RowVar1) Selection.Copy Windows("Destination data.xlsx").Activate Range("N45").Select 'would like to change to Range("N"&RowVar2) ActiveSheet.Paste Link:=True Windows("source data.xlsm").Activate Range("J266").Select 'would like to change to Range("H"&RowVar1) Application.CutCopyMode = False Selection.Copy Windows("Destination data.xlsx").Activate Range("O45").Select' would like to change to Range("N"&RowVar2) ActiveSheet.Paste Link:=True Windows("source data.xlsm").Activate Range("K266").Select 'would like to change to Range("H"&RowVar1) Application.CutCopyMode = False Selection.Copy Windows("Destination data.xlsx").Activate Range("P45").Select 'would like to change to Range("N"&RowVar2) ActiveSheet.Paste Link:=True "PhilosophersSage" wrote: I have several workbooks, source data (SD) and destination data (DD) which are portions of SD, I would like to make a macro that would search for matching values between SD column L & DD column B and if there is a match copy a link from SD column H, J & K to DD column N, O & P this way I can reduce entry points for data. The big problem I have is the search between workbooks, also I cannot get the paste function to give a link between workbooks. Any help or pointers anyone can give me I would really appreciate it! Thank you! |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy and Paste link between workbooks
Okay, this code is for the source & destination in separate workbooks.
The first try was for one workbook with 2 worksheets. 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("SourceData.xlsx") ' change to your workbook name Set dwb = Workbooks("FindValuesSh1-CopyToSht2.xlsm") ' change filename Set sd = Worksheets("source") Set dd = Worksheets("destination") swb.Activate sd.Activate LastRowS = Cells(Cells.Rows.Count, "L").End(xlUp).Row Set rngS = Range("L2:L" & LastRowS) dwb.Activate 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 dd.Cells(x, 15).Formula = cell.Offset(0, -2).Value dd.Cells(x, 16).Formula = cell.Offset(0, -1).Value End If Next Next x Application.ScreenUpdating = True End Sub HTH -- Data Hog |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy and Paste link between workbooks
Had to move the set sd and dd til after workbook activated. but for the most
part the code works to copy data; however, it seems to skip a few lines. It may be because not all the data is congruant. Also I would like the macro to paste a line back to origonal cell rather then just the data. 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("destinatio.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, 13).Formula = cell.Offset(0, -6).Value 'Sets column M source to column F 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 "DOne" End Sub "J_Knowles" wrote: Okay, this code is for the source & destination in separate workbooks. The first try was for one workbook with 2 worksheets. 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("SourceData.xlsx") ' change to your workbook name Set dwb = Workbooks("FindValuesSh1-CopyToSht2.xlsm") ' change filename Set sd = Worksheets("source") Set dd = Worksheets("destination") swb.Activate sd.Activate LastRowS = Cells(Cells.Rows.Count, "L").End(xlUp).Row Set rngS = Range("L2:L" & LastRowS) dwb.Activate 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 dd.Cells(x, 15).Formula = cell.Offset(0, -2).Value dd.Cells(x, 16).Formula = cell.Offset(0, -1).Value End If Next Next x Application.ScreenUpdating = True End Sub HTH -- Data Hog |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy and Paste link between workbooks
Here is the revised code. I used the Worksheet.UsedRange.Rows.Count to get
the number of row cells, redefined sd & dd. and pasted in the references to the source workbook. Both workbooks need to be opened before running the routine. Sub FindMatchesInBooksR1() 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("SourceData.xlsx") ' change workbook name Set dwb = Workbooks("FindValuesSh1-CopyToSht2.xlsm") ' change workbook Set sd = swb.Worksheets("source") 'revised code Set dd = dwb.Worksheets("destination") 'revised code sd.Activate LastRowS = ActiveSheet.UsedRange.Rows.Count 'revised code Set rngS = Range("L2:L" & LastRowS) dd.Activate LastRowD = ActiveSheet.UsedRange.Rows.Count 'revised code For x = 2 To LastRowD For Each cell In rngS If dd.Cells(x, 2).Value = cell.Value Then 'revised code dd.Cells(x, 14).Formula = "=[" & swb.Name & "]" & sd.Name & _ "!" & cell.Offset(0, -4).Address(False, False) dd.Cells(x, 15).Formula = "=[" & swb.Name & "]" & sd.Name & _ "!" & cell.Offset(0, -2).Address(False, False) dd.Cells(x, 16).Formula = "=[" & swb.Name & "]" & sd.Name & _ "!" & cell.Offset(0, -1).Address(False, False) End If Next Next x Application.ScreenUpdating = True End Sub HTH -- Data Hog "PhilosophersSage" wrote: Had to move the set sd and dd til after workbook activated. but for the most part the code works to copy data; however, it seems to skip a few lines. It may be because not all the data is congruant. Also I would like the macro to paste a line back to origonal cell rather then just the data. |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy and Paste link between workbooks
I get a Runtime Error 1004 when trying to execute this code.
dd.Cells(x, 14).Formula = "=[" & swb.Name & "]" & sd.Name & _ "!" & cell.Offset(0, -4).Address(False, False) "J_Knowles" wrote: Here is the revised code. I used the Worksheet.UsedRange.Rows.Count to get the number of row cells, redefined sd & dd. and pasted in the references to the source workbook. Both workbooks need to be opened before running the routine. Sub FindMatchesInBooksR1() 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("SourceData.xlsx") ' change workbook name Set dwb = Workbooks("FindValuesSh1-CopyToSht2.xlsm") ' change workbook Set sd = swb.Worksheets("source") 'revised code Set dd = dwb.Worksheets("destination") 'revised code sd.Activate LastRowS = ActiveSheet.UsedRange.Rows.Count 'revised code Set rngS = Range("L2:L" & LastRowS) dd.Activate LastRowD = ActiveSheet.UsedRange.Rows.Count 'revised code For x = 2 To LastRowD For Each cell In rngS If dd.Cells(x, 2).Value = cell.Value Then 'revised code dd.Cells(x, 14).Formula = "=[" & swb.Name & "]" & sd.Name & _ "!" & cell.Offset(0, -4).Address(False, False) dd.Cells(x, 15).Formula = "=[" & swb.Name & "]" & sd.Name & _ "!" & cell.Offset(0, -2).Address(False, False) dd.Cells(x, 16).Formula = "=[" & swb.Name & "]" & sd.Name & _ "!" & cell.Offset(0, -1).Address(False, False) End If Next Next x Application.ScreenUpdating = True End Sub HTH -- Data Hog "PhilosophersSage" wrote: Had to move the set sd and dd til after workbook activated. but for the most part the code works to copy data; however, it seems to skip a few lines. It may be because not all the data is congruant. Also I would like the macro to paste a line back to origonal cell rather then just the data. |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy and Paste link between workbooks
The Activate command (to select the workbook & worksheet) may be the problem.
Sub FindMatchesInBooksR2() 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("SourceData.xlsx") ' change workbook name Set dwb = Workbooks("FindValuesSh1-CopyToSht2.xlsm") ' change workbook Set sd = Worksheets("source") Set dd = Worksheets("destination") swb.Activate sd.Activate LastRowS = ActiveSheet.UsedRange.Rows.Count 'revised code Set rngS = Range("L2:L" & LastRowS) dwb.Activate dd.Activate LastRowD = ActiveSheet.UsedRange.Rows.Count ' revised code For x = 2 To LastRowD For Each cell In rngS If dd.Cells(x, 2).Value = cell.Value Then dd.Cells(x, 14).Formula = "=[" & swb.Name & "]" & sd.Name & _ "!" & cell.Offset(0, -4).Address(False, False) dd.Cells(x, 15).Formula = "=[" & swb.Name & "]" & sd.Name & _ "!" & cell.Offset(0, -2).Address(False, False) dd.Cells(x, 16).Formula = "=[" & swb.Name & "]" & sd.Name & _ "!" & cell.Offset(0, -1).Address(False, False) End If Next Next x Application.ScreenUpdating = True End Sub -- Data Hog "PhilosophersSage" wrote: I get a Runtime Error 1004 when trying to execute this code. dd.Cells(x, 14).Formula = "=[" & swb.Name & "]" & sd.Name & _ "!" & cell.Offset(0, -4).Address(False, False) "J_Knowles" wrote: Here is the revised code. I used the Worksheet.UsedRange.Rows.Count to get the number of row cells, redefined sd & dd. and pasted in the references to the source workbook. Both workbooks need to be opened before running the routine. Sub FindMatchesInBooksR1() 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("SourceData.xlsx") ' change workbook name Set dwb = Workbooks("FindValuesSh1-CopyToSht2.xlsm") ' change workbook Set sd = swb.Worksheets("source") 'revised code Set dd = dwb.Worksheets("destination") 'revised code sd.Activate LastRowS = ActiveSheet.UsedRange.Rows.Count 'revised code Set rngS = Range("L2:L" & LastRowS) dd.Activate LastRowD = ActiveSheet.UsedRange.Rows.Count 'revised code For x = 2 To LastRowD For Each cell In rngS If dd.Cells(x, 2).Value = cell.Value Then 'revised code dd.Cells(x, 14).Formula = "=[" & swb.Name & "]" & sd.Name & _ "!" & cell.Offset(0, -4).Address(False, False) dd.Cells(x, 15).Formula = "=[" & swb.Name & "]" & sd.Name & _ "!" & cell.Offset(0, -2).Address(False, False) dd.Cells(x, 16).Formula = "=[" & swb.Name & "]" & sd.Name & _ "!" & cell.Offset(0, -1).Address(False, False) End If Next Next x Application.ScreenUpdating = True End Sub HTH -- Data Hog "PhilosophersSage" wrote: Had to move the set sd and dd til after workbook activated. but for the most part the code works to copy data; however, it seems to skip a few lines. It may be because not all the data is congruant. Also I would like the macro to paste a line back to origonal cell rather then just the data. |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Can't Copy and Paste or Paste Special between Excel Workbooks | Excel Discussion (Misc queries) | |||
paste formulas between workbooks without workbook link | Excel Discussion (Misc queries) | |||
problem with Linking workbooks via "copy" and "paste link" | Excel Discussion (Misc queries) | |||
Copy and paste from several Workbooks | Excel Programming | |||
Copy and Paste Between Workbooks | Excel Programming |