Sub CopySelectedRange()

    Dim rng As Range, cel As Range
    Dim PasteHere As Range, NumCols As Integer
    
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
NumCols = Application.InputBox("How many columns should be used for the paste?")
    If Not IsNumeric(NumCols) Or NumCols = 0 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 = NumCols Then
            j = 0
            i = i + 1
        End If
    End If
Next cel

End Sub