Sub Avtofill_Input()
Set sh1 = Sheets("Introduction")
Set sh2 = Sheets("Input")
lstr = Cells(Rows.Count, "A").End(xlUp).Row
sh1.Range("A2:B" & lstr).Copy sh2.[A2]
i = 2
With sh2
While .Cells(i, 2) <> ""
If Len(.Cells(i, 2)) > 4 Then
.Cells(i, 2).Cut .Cells(i, 2).Offset(, 1)
End If
i = i + 1
Wend
End With
End Sub
 

Sub Avtofill_Input()
Set sh1 = Sheets("Introduction")
Set sh2 = Sheets("Input")
i = 2
With sh1
While .Cells(i, 1) <> ""
Set resu = sh2.Range("A:A").Find(.Cells(i, 1), , xlValues)
If Not resu Is Nothing Then
If Len(.Cells(i, 1)) > 4 Then
.Cells(i, 2) = resu.Offset(, 1)
Else
.Cells(i, 3) = resu.Offset(, 1)
End If
End If
i = i + 1
Wend
End With
End Sub
 

Sub test()
i = 1
Do
lrow = Cells(Rows.Count, "A").End(xlUp).Offset(1).Row
x = Environ(i)
Cells(lrow, 1) = x
i = i + 1
Loop Until x = ""
End Sub