Copy with lookup

Registration date
Sunday June 14, 2009
Last seen
August 7, 2021

I am working with 2 Excel, One field is common in both the excel "SID". I need to copy the row of SID say 'ABC' from Excel B and append to the row of same SID 'ABC' in excel A.
Please note I have 14 sheets in Excel B. The source where SID has to be searched and row needs to be fetched.
so I have 2 challenges infront of me:
1. Pick one SID from Excel A and search it in 14 sheets of excel B

2. After finding copy the corresponding row in excel B and append it in the picked SID in Excel A.


Excel A
SID Message Number Order date
ABC 43556 23/05/2009

Excel B
Sheet 3 <just for example>
SID Total days SDT
XYZ 12 45
ABC 21 32

Result should be in Excel A :
ABC 43556 23/05/2009 21 32

Please help.

Thank you,

1 reply

Registration date
Sunday June 14, 2009
Last seen
August 7, 2021

I am giving you a macro "test" for this purpose. in the sample workbook excel A(remember there is space between "excel"and "A") sheet1 where you have the main data add one more sample data in the third from A3 to right like this
jkh 23456 5/30/2009

both the SAMPLE workbooks must have been saved and open

then try the macro (I have given another macro "undo" which undoes the result of the macro "test"
If there is problem tell me which code statement gives the problem and error message if any

Park the macros in the vb editor of excel A (thought strictly it does not matter)
test the macros in the sample workbooks and if it is successful use the macro in your original file . BEFORE DOING THAT KEEP THE ORIGNAL FILES SAFELY SOMEWHERE SO THAT THE FILES CAN BE RETRIEVED IF THERE IS A MESS UP.

the macro are

Sub test() 
Dim r As Range, c As Range 
Dim x As String, j As Integer, k As Integer 
Dim cfind As Range, r1 As Range 
With Workbooks("excel A.xls").Worksheets("sheet1") 
Set r = Range(.Range("A2"), .Range("A2").End(xlDown)) 
For Each c In r 
x = c.Value 
With Workbooks("excel B.xls") 
j = .Worksheets.Count 
For k = 1 To j 
With .Worksheets(k) 
Set cfind = .Cells.Find(what:=x, lookat:=xlWhole) 
If Not cfind Is Nothing Then 
Set r1 = Range(cfind.Offset(0, 1), cfind.End(xlToRight)) 
GoTo pasting 
End If 
End With 'worksheets(k) 
Next k 
Exit Sub 
End With 'second book 
c.Offset(0, 3).PasteSpecial 
Next c 
End With 'first book 
End Sub

Sub undo() 
With Workbooks("excel A.xls").Worksheets("sheet1") 
Range(.Range("d1"), .Range("d1").End(xlToRight)).EntireColumn.Delete 
End With 
End Sub
Thank you

A few words of thanks would be greatly appreciated. Add comment

CCM 2821 users have said thank you to us this month