Привет!
[vba]Код
Option Explicit
Public Sub Фильтр_Копировать_Параллельно()
Dim rng As Range
Set rng = Selection.SpecialCells(xlCellTypeVisible)
On Error Resume Next
Dim rngInput As Range
Set rngInput = Application.InputBox(Prompt:="Выберите ячейку или введите в формате A1:", Type:=8)
On Error GoTo 0
If Not rngInput Is Nothing Then
Dim СтолбецСмещения
СтолбецСмещения = rngInput.Column - rng.Column
Else
Exit Sub '==>>
End If
Dim eL As Range
For Each eL In rng
eL.Offset(0, СтолбецСмещения).Value = eL.Value
Next
MsgBox "Всё !"
End Sub
[/vba]