Sub a()
Dim i As Integer
Dim j As Integer
ws1.[b2].CurrentRegion.Copy ws3.[b2]
For i = 3 To 8
For j = 3 To 8
If Trim(Left(ws3.Cells(j, 2), 6)) = Trim(ws2.Cells(i, 2)) Then
ws3.Cells(j, 2).Offset(0, 3) = ws2.Cells(i, 2).Offset(0, 1)
End If
Next j
Next i
End Sub