Sub FindSelectCopyPaste()

'By Muhammad Anisur Rahman
'Date: 10/03/2009
'Find Select- Copy and Paste Row from Sheet2 to Sheet 1


Dim r As Long
Dim LastRow1 As Long
Dim LastRow2 As Long
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim strLookup As String



Set ws1 = Worksheets("Sheet1")

Set ws2 = Worksheets("Sheet2")

'Find LastRow for Sheet1
LastRow1 = ws1.Cells(65536, 1).End(xlUp).Row


'Find LastRow for Sheet2
LastRow2 = ws2.Cells(65536, 1).End(xlUp).Row


ws2.Select 'select sheet2



Set rngLookup = Range("B1", Cells(LastRow2, 2))


 For i = 4 To LastRow1 'LastRow of Sheet2
 
            strLookup = ws1.Cells(i, 1) 'There are a list of names in cells A4:A33... A(n) or more


            r = Application.WorksheetFunction.Match(strLookup, rngLookup, 0) 'Find Row number of Sheet2 as per above criteria

              
                With ws2
                
                'Copy the Row Range C(r):S(r) [r is a row number]
                'Paste into next column of criteria [Next to "ABC"] in sheet1,
                .Range(.Cells(r, 3), .Cells(r, 19)).Copy ws1.Cells(i, 2)
                
                End With
                


Next i


ws1.Select 'select Sheet1


End Sub

Private Sub CommandButton1_Click()
    Dim row As Integer, col As Integer
    row = 4
    col = 1
    
    For row = 4 To 33
        findMatch Sheet1.Cells(row, col).Value, row
    Next
End Sub

Private Sub findMatch(str As String, i As Integer)
    Dim row As Integer, col As Integer
    row = 1
    col = 2
    
    While Sheet2.Cells(row, col).Value <> ""
        If str = Sheet2.Cells(row, col).Value Then
            For col = 3 To 19
                Sheet1.Cells(i, col).Value = Sheet2.Cells(row, col).Value
            Next
            
        End If
        row = row + 1
    Wend
    
End Sub