zellwert suchen und einfügen

Sub Test()
Dim i, ersteZeile, letzteZeile As Integer
Dim Wert1, Wert2 As Integer
Set wsQ = Worksheets("Tabelle1")
Set wsA = Worksheets("Tabelle2")
ersteZeile = wsQ.Cells(7, 2).Row
letzteZeile = wsQ.Cells(ActiveSheet.Rows.Count, 3).End(xlUp).Row
For i = ersteZeile To letzteZeile
'Anfang
If Not wsQ.Cells(i, 40).Value = "" Then
Wert1 = wsQ.Cells(i, 5).Value
Wert2 = wsQ.Cells(i, 40).Value
If Wert1 = Application.WorksheetFunction _
.VLookup(Wert1, wsA.Range("C3:H45"), 1, 0) Then
'Wert1 ist gefunden, aber wie bekomme ich jetzt Wert2 in Spalte 5 eingetragen?
wsA.Cells(1, 1).Value = "gefunden"
End If
End If
Next
End Sub