Slight tweaking Required to a Search & Transpose Macro

Hi,

I need some tweaking in a macro I came across while doing research on my problem. That macro is very close to what I need, however it does require slight modification which I am unable to do on my own.

The following macro works well for searching/matching each entry of column A in the first sheet to column A in the second sheet and then for each entry found in column A (second sheet) transposing and pasting the adjacent entry from column B (second sheet) next to the entry being searched from sheet 1. If multiple matches are found then results are pasted horizontally starting from column B in the first sheet.


As stated earlier, the macro copied below works well from the above assignment.

I however, need the macro tweaked to search each entry of column A in the first sheet to a range im second sheet starting from B2:B200 thru K2:K200 (that is column B thru K going 200 rows deep) and then for the rows that have matches copy and transpose the corresponding entry from column A (second sheet) next to the entry being searched from sheet 1. If multiple matches are found then results are pasted horizontally starting from column B in the first sheet.


The following macro is by a contributor Jerry Beaucaire.

Option Explicit

Sub TransposeSecondaryValues()
'JBeaucaire (11/11/2009)
'Turns columnar date on sheet into row data in another
Dim LR As Long, Rng As Range, cell As Range
Application.ScreenUpdating = False

Sheets("list of search criteria").Activate
Range("B3:J" & Rows.Count).ClearContents
LR = Range("A" & Rows.Count).End(xlUp).Row
Set Rng = Range("A3:A" & LR)

With Sheets("sheet 1 data")
.Range("A1").AutoFilter
For Each cell In Rng
.Range("A1").AutoFilter Field:=1, Criteria1:=cell.Text
LR = .Range("A" & Rows.Count).End(xlUp).Row
If LR > 1 Then
.Range("B2:B" & LR).Copy
cell.Offset(0, 1).PasteSpecial xlPasteValues, Transpose:=True
End If
Next cell
.Range("A1").AutoFilter
End With

Application.ScreenUpdating = True
End Sub