try this
Sub populatesheet2()
Const AlphabetizedSheet = "Sheet1"
Const PopulateSheet = "Sheet2"
With Sheets(AlphabetizedSheet)
.Activate
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
Set ShAlphaRange = Range(.Cells(2, "A"), _
.Cells(LastRow, "A"))
End With
With Sheets(PopulateSheet)
.Activate
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
Set ShPopulateRange = Range(.Cells(2, "A"), _
.Cells(LastRow, "A"))
End With
Sheets(AlphabetizedSheet).Activate
For Each cell In ShAlphaRange
Set c = ShPopulateRange. _
Find(what:=cell.Value, LookIn:=xlValues)
If Not c Is Nothing Then
Set CopyRange = Range(Cells(cell.Row, "B"), _
Cells(cell.Row, "K"))
CopyRange.Copy _
Destination:=Sheets(PopulateSheet). _
Range("B" & c.Row)
End If
Next cell
End Sub