Autofill Colums based on combo box choice

I have attached a rudimentary sheet. I was wondering how I could populate the values from Sheet2, onto the column in Sheet1, based on the combobox choice.

Sub Transfer_Answers()
Dim ws1 As Worksheet:   Set ws1 = Sheets("Sheet1")
Dim ws2 As Worksheet:   Set ws2 = Sheets("Sheet2")
Dim rFind As Range
Dim strName As String

strName = ws1.OLEObjects("Combobox1").Object.Value

If strName = "" Then
    MsgBox ("There is no name selected")
    Exit Sub
End If

Set rFind = ws2.Range("A1:A" & ws2.Range("A" & Rows.Count).End(xlUp).Row).Find(What:=strName, LookIn:=xlValues, LookAt:=xlWhole)

If Not rFind Is Nothing Then
    ws1.Range("B2:B6").Copy  'your question range
    rFind.Offset(0, 1).PasteSpecial xlPasteValues, , , True
Else
   Msgbox("That name could not be found")
End If

Application.CutCopyMode = False

End Sub

When this is applied to the combobox1 change event, it takes the blanks on sheet 1 and writes them to Sheet 2, leaving my data blank. I was looking for reading sheet 2 and displaying the values on Sheet 1. I'm sorry if I was not clear :/

Sub Transfer_Answers()
Dim ws1 As Worksheet:   Set ws1 = Sheets("Sheet1")
Dim ws2 As Worksheet:   Set ws2 = Sheets("Sheet2")
Dim rFind As Range
Dim strName As String

strName = ws1.OLEObjects("Combobox1").Object.Value

If strName = "" Then
    MsgBox ("There is no name selected")
    Exit Sub
End If

Set rFind = ws2.Range("A1:A" & ws2.Range("A" & Rows.Count).End(xlUp).Row).Find(What:=strName, LookIn:=xlValues, LookAt:=xlWhole)

If Not rFind Is Nothing Then
    rFind.Offset(0, 1).Resize(1, 5).Copy 'your question range
    ws1.Range("B2").PasteSpecial xlPasteValues, , , True
Else
   MsgBox ("That name could not be found")
End If

Application.CutCopyMode = False

End Sub