Sub Vstavit()
Dim rCell As Range
Dim lCol As Long, lRow As Long
Dim sVal As String
Application.ScreenUpdating = False
With Worksheets("222")
For Each rCell In .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
lCol = rCell.Offset(, 2).Value
lRow = rCell.Offset(, 3).Value
sVal = rCell.Value & " " & rCell.Offset(, 1).Value
With Worksheets("111")
rCell.Copy .Cells(lRow + 2, lCol + 2)
.Cells(lRow + 2, lCol + 2).Value = sVal
End With
Next rCell
End With
Application.ScreenUpdating = True
End Sub
заменил названия листов на 222 (откуда берутся данные) на 111 - куда надо вставлять.