VBA Code - Update Code to pull two columns instead of one. Help needed

[Realjoshtodd]

Private Sub Worksheet_Change(ByVal Target As Range)

Dim vSourceSheet As Worksheet
Dim VRow As Range
Dim VTargetCounter As Long

If Target.Address = "$A$1" Then
    ' clear out the names in the target column
    Range("A2:A" & Rows.Count).Clear

    ' read through Sheet1 and populate names into Sheet2
    VTargetCounter = 2
    Set vSourceSheet = ThisWorkbook.Worksheets("Sheet1")
    For Each VRow In vSourceSheet.Range("A1:A" & vSourceSheet.Range("A" & vSourceSheet.Rows.Count).End(xlUp).Row)
        If VRow.Cells(1, 1) = Target.Value2 Then
            Target.Cells(VTargetCounter, 1) = VRow.Cells(1, 2)
            VTargetCounter = VTargetCounter + 1
        End If
    Next
End If
End Sub

The code listed currently looks at Sheet2 cell A1, and fills in the all of the names from Sheet1 Column B when Sheet2 cell A1 matches the data in Sheet1 Column A. I need the code to also pull the data in those matches that is Sheet1 Column C and add it in Sheet2 Column B next to the names already populating in Column A on Sheet 2.

 

[Fluff]

How about

Target.Cells(VTargetCounter, 1).Resize(,2).Value = VRow.Cells(1, 2).Resize(, 2).Value

 

[Realjoshtodd]

Perfect, thank you so much

 

[Fluff]

You're welcome & thanks for the feedback.