VBA code to copy a row of data from one workbook to a master workbook based on unique cell value

SimpleSusan

New Member
Joined
May 8, 2013
Messages
7
Hi, as my name suggests, I'm not that cluey when it comes to writing VBA. I have read through a huge number of posts and still can't seem to get the code I need. My scenario is:

I have a workbook (AAA System File) that has worksheet (Master Summary) with data in it from B6 to AF6. The value in B6 is the unique ID for the file.

I have another workbook (AAB Incident Records) that contains a worksheet (Master Summary) with a list of IDs in column B.

What I want to do is code a command button in the AAA System File that when clicked:
1) copies the data from Worksheet "Master Summary" B6 to AF6
2) Opens workbook "AAB Incident Records"
3) Selects worksheet "Master Summary"
4) looks for the unique ID in column B that matches the copied cell B6 from the previous workbook
5) Once found, pastes the copied row of data in the correct row
6) Saves the file "AAB Incident Records"
7) Closes the file "AAB Incident Records"

Points 6 and 7 I can do easily. But no matter what I do, I can't seem to get the match then copy to work. I'd be happy to compromise have the entire row pasted rather than just the range B to AF.

I guess I'll need some sort of error handler also for the odd event where the copied ID does not appear in the AAB Incident Records "Master Summary" list

Can anyone help me please? Hopefully I've provided enough information.
Thanks, Susan
 

Some videos you may like

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.

AlphaFrog

MrExcel MVP
Joined
Sep 2, 2009
Messages
16,384
Try something like this. Set the path and file name for "AAB Incident Records" to suit.

Code:
[COLOR=darkblue]Sub[/COLOR] Copy_Matched_ID()
    
    [COLOR=darkblue]Dim[/COLOR] wbAAB [COLOR=darkblue]As[/COLOR] Workbook
    [COLOR=darkblue]Dim[/COLOR] ws [COLOR=darkblue]As[/COLOR] Worksheet
    [COLOR=darkblue]Dim[/COLOR] Found [COLOR=darkblue]As[/COLOR] Range
    
    [COLOR=darkblue]Set[/COLOR] ws = ThisWorkbook.Worksheets("Master Summary")
      
    [COLOR=red]Set wbAAB = Workbooks.Open(ThisWorkbook.Path & "\AAB Incident Records.xls")[/COLOR]
    
    [COLOR=darkblue]With[/COLOR] wbAAB.Sheets("Master Summary").Range("B:B")
        [COLOR=darkblue]Set[/COLOR] Found = .Find(What:=ws.Range("B6").Value, _
                          LookIn:=xlValues, _
                          LookAt:=xlWhole, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlNext, _
                          MatchCase:=False)
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
                          
    [COLOR=darkblue]If[/COLOR] [COLOR=darkblue]Not[/COLOR] Found [COLOR=darkblue]Is[/COLOR] [COLOR=darkblue]Nothing[/COLOR] [COLOR=darkblue]Then[/COLOR]
        Found.Resize(, 31).Value = ws.Range("B6:AF6").Value
        wbAAB.Close SaveChanges:=[COLOR=darkblue]True[/COLOR]
        MsgBox "Data copied and saved. ", vbInformation, "ID Matched"
    [COLOR=darkblue]Else[/COLOR]
        MsgBox "ID: " & ws.Range("B6").Value, vbExclamation, "No Match Found"
        wbAAB.Close SaveChanges:=[COLOR=darkblue]False[/COLOR]
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
 

SimpleSusan

New Member
Joined
May 8, 2013
Messages
7
Wow, thank you so much. This works perfectly! I'm assuming if I need to extend the range I need to change the following line:

Found.Resize(, 31).Value = ws.Range("B6:AF6").Value

To (for example):

Found.Resize(, 33).Value = ws.Range("B6:AH6").Value

Cheers
Susan
 

Watch MrExcel Video

Forum statistics

Threads
1,122,893
Messages
5,598,712
Members
414,254
Latest member
MarieCo

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top