オートフィルタしたセル内容を、フィルタしたセルに貼り付ける

Excelで、オートフィルタをかけたまま、その内容を別の列にコピーしたい
ということがありますが、普通にはどうしてもできないので、マクロで可能にしました。
こちらをアドインに登録しておくと便利です。
（自分用につき変数宣言無しの酷いコードですが、ご容赦下さい）

'フィルタしたまま貼り付け
'フィルタされた内容を、フィルタしたまま、他の列に値貼り付けするマクロです。
Sub PastetoFilterCells()
If Application.CutCopyMode <> False Then
    Call AlertStop("このボタンは、元のセルをコピーではなく選択した状態で実行して下さい")
End If
'選択範囲のフィルターされたセル（可視セル）のみ選択する
Set motorange = Selection.SpecialCells(xlCellTypeVisible)
If motorange.Columns.Count > 1 Then
    Call AlertStop("このボタンは、１列かつ２行以上選択して実行して下さい")
End If

'全行・全列に処理すると時間がかかるので、しないようにチェック
If Selection(Selection.Count).Row = Cells.Rows.Count Or _
    Selection(Selection.Count).Column = Cells.Columns.Count Then
    MsgBox "このボタンは列全体・行全体に処理はできません", vbInformation
    End
End If    

'貼り付け先の列を選択してもらう。行はどこでもいい。
On Error Resume Next
Set buf = Application.InputBox("貼り付け先の列のセル（どこでも可）を選んで下さい。", "コピー先列選択", Type:=8)
If buf Is Nothing Then End
On Error GoTo 0

'貼り付け元を、貼り付け先に入力していく。（DoEvents無い方が早いかも？）
mycolcnt = buf.Column - motorange.Column
Application.ScreenUpdating = False
For Each hoge In motorange
    hoge.Offset(, mycolcnt).Value = hoge.Value
    DoEvents
Next
Application.ScreenUpdating = True   
End Sub