Sub CopySelectedRange()

On Error Resume Next    'incase input box canceled
Set rng = Application.InputBox("Use the mouse to select the range to copy", Type:=8)
    If rng Is Nothing Then Exit Sub
Set PasteHere = Application.InputBox("Use the mouse to select the upper left cell for the paste", Type:=8)
    If PasteHere Is Nothing Then Exit Sub
On Error GoTo 0         'turn error notification back on

For Each cel In rng
    If cel.Value <> "" Then
        PasteHere.Offset(i, j) = cel.Value
        j = j + 1
        If j = 2 Then
            j = 0
            i = i + 1
        End If
    End If
Next cel

End Sub