[Spirosgr]

Καλημέρα
Επειδή υπάρχουν ασάφειες στο ερώτημα, πχ
Οι επιλογές θα έχουν πάντα ίδιο ύψος; (γραμμές)
Που ακριβώς στο φύλλο 3, θα πάνε;

Ο πιο κάτω κώδικας, λέει το εξής:
Επιλέγουμε οτιδήποτε θέλουμε, από την Used Range του πρώτου φύλλου.
Με το Ctrl, έχουμε πολλαπλές επιλογές...

Αν δεν επιλέξουμε κάτι, μνμ σφάλματος.

Ορίζουμε στο Input, την στήλη προορισμού στο φύλλο πχ 3 = C
Η μεταφορά, γίνεται από την επιλεγμένη στήλη (έως όπου είναι... συνεχόμενα) και
από την γραμμή 2 και κάτω (για τυχόν κεφαλίδες)

Αν θέλουμε τις υπάρχουσες κεφαλίδες του φύλλου 1
τις επιλέγουμε και αλλάζουμε το:
Selection.Copy Destination:=Sheet3.Cells(2, iInput) σε:
Selection.Copy Destination:=Sheet3.Cells(1, iInput)

Sub CopySelection()
    Dim iColumn As Integer
    If Intersect(Selection, Sheet1.UsedRange) Is Nothing Then
        MsgBox "Η επιλογή δεν είναι σωστή"
        GoTo ExitHR:
    End If

    On Error GoTo ExitHR:
    Dim iInput As Integer
    iInput = Application.InputBox _
             ("Ok = ENTER, Cancel = ESC", "Εισάγετε Αριθμό Στήλης Προορισμού", 1, Type:=1)

    Sheet3.UsedRange.ClearContents
    Selection.Copy Destination:=Sheet3.Cells(2, iInput)
    Application.CutCopyMode = False
    Sheet3.UsedRange.Columns.AutoFit
ExitHR:
End Sub