Sub danny()
Dim R, cell As Range
Set R = Blad2.Range("A3:A28")
For Each cell In R
cell.Offset(0, 3).Value = Application.WorksheetFunction.VLookup(cell, Blad1.Range("B1:G39"), 4, 0)
cell.Offset(0, 5).Value = Application.WorksheetFunction.VLookup(cell, Blad1.Range("B1:G39"), 6, 0)
Next cell
End Sub