Q: To find keyword and copy range of data I have 6 excel workbooks: 1- workbook has 19 columns and 40 rows (Master workbook) and other 5 workbooks has same 19 column names as workbook1 and same 8 row names as workbook1 (the 40 rows in workbook1 is divided into 5 workbooks thus 8 rows in each workbook)  I need to copy range of data from workbook1 by exactly matching the rownames into all the 5 workbooks. All the five workbooks are represented by its unique id which is present in the master workbook so by matching that primary key the range of data has to be copied and pasted in that particular workbook only. My code helps me to copy the data by matching the rownames from one workbook to another workbook but I dont know how to find the primary key and transfer that particular range into that particular workbook. All the 5 workbooks are in the same folder.
For example:
Workbook1:

      Icn  Primarykey  Location  Q1    Q2
       1   125          M        25    30
       2   125          F        30    35
       3   125          G        40    45
       4   125          H        50    55
       5   125          I        60    56

       1   126          M        21    31
       2   126          F        32    37
       3   126          G        41    48
       4   126          H        53    59
       5   126          I        62    50

       1   127          M        28    39
       2   127          F        38    39
       3   127          G        48    49
       4   127          H        58    57
       5   127          I        68    57
Workbook2:
125
icn  id  Location Q1 Q2
1
3
5
4
2

Workbook3:
126
icn  id  Location Q1 Q2
1
3
5
4
2

Workbook4:
127
icn  id  Location Q1 Q2
1
3
5
4
2

My code:
Sub UpdateW2()
    Dim w1 As Worksheet, w2 As Worksheet
    Dim c As Range
    Dim FR As Variant '<-- use Variant to allow catching a Error value
    Dim ws1Range As Range, ws2Range As Range

    Application.ScreenUpdating = False

    Set w1 = Workbooks("workbookA.xlsm").Worksheets("Sheet1")
    Set w2 = Workbooks("workbookB.xlsm").Worksheets("Sheet1")

    Set ws1Range = w1.Range("A2", w1.Range("A" & w1.Rows.Count).End(xlUp))
    Set ws2Range = w2.Range("A2", w2.Range("A" & w2.Rows.Count).End(xlUp))

    For Each c In ws2Range
        FR = Application.Match(c.Value, ws1Range, 0)
        If Not IsError(FR) Then
            ' Choose ONE of the next three blocks of code

            ' To copy formula and format
            'ws1Range.Cells(FR, 2).Resize(, 2).Copy Destination:=c.Cells(1, 2).Resize(, 2)

            ' to copy only values
            'c.Cells(1, 2).Resize(, 2) = ws1Range.Cells(FR, 2).Resize(, 2)

            ' To copy values and format
            c.Cells(1, 2).Resize(, 2) = ws1Range.Cells(FR, 2).Resize(, 2)
            ws1Range.Cells(FR, 2).Resize(, 2).Copy
            c.Cells(1, 2).Resize(, 2).PasteSpecial Paste:=xlPasteFormats
        End If
    Next c
    Application.ScreenUpdating = True
End Sub

