Forum - VBA Πρόβλημα σε macro του excel

Forum (https://www.ms-office.gr/forum/)

- Excel - Ερωτήσεις / Απαντήσεις (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/)

- - [VBA] Πρόβλημα σε macro του excel (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/1899-problima-se-macro-toy-excel.html)

Πρόβλημα σε macro του excel

Κύριοι!!
Σας παραθέτω το πρόβλημά μου.
Σε καταγραφή μακροεντολής στο excel προσπαθώ να συντάξω την εκάστοτε τυχαία επιλογή κελλιού στο οποίο θα εφαρμόσω την εντολή paste.
Συγκεκριμένα:
Θέλω το περιεχόμενο του εύρους των κελιών Range("C3:I72").Select
Selection.Copy
να αντιγράφεται και να επικολλάται σε κελί της στήλης C που θα επιλέγω εγώ κάθε φορά και πριν από την εκτέλεση της συγκεκριμένης μακροεντολής δηλ. μπορεί να είναι το C73 ή άλλη φορά το C102, ή άλλη φορά το C 150 και ούτω καθ εξής.
Πως λοιπόν θα συντάξω στην μακροεντολή την εκάστοτε επιλογή του κελιού που εγώ θα κρίνω;;;;;;

Αναμένοντας κάποια βοήθεια
διατελώ με τιμή
Γιάννης Ζέζιος

Καλησπέρα

Γιάννη, καλωσόρισες στο φόρουμ.

Στο αρχείο που επισυνάπτω μπορούμε, αφού επιλέξουμε μια περιοχή κελιών, να πατήσουμε στο κουμπί «Επικόλληση» και να την επικολλήσουμε όπου θέλουμε.

Πιστεύω να σε καλύπτει.

Φιλικά/Γιώργος

Φίλε Γιάννη,
κατ'αρχή καλώς όρισες στην παρέα μας.

Αν και η λύση μου είναι παρόμοια με αυτή του Γιώργου, μιας και την ετοίμασα την ανεβάζω.

ο παρακάτω κώδικα σου επιτρέπει να επιλέξεις τόσο την προέλευση (sRange) όσο και το κελί προορισμού.

Προσάρμοσέ το ανάλογα πχ άλλαξε το ThisWorkbook.Sheets(1).Range("C3:I72").Address να ορίσζει την προτιμόμενη περιοχή προέλευσης.

Φιλικά
Θανάσης

Κώδικας:

Sub Copy_sRange_to_Dest()

Dim sRange As Range

Dim Dest As Range
 

On Error Resume Next

Set sRange = Application.InputBox("Select source range", _

    "Select Source", ThisWorkbook.Sheets(1).Range("C3:I72").Address, , , , , 8)

Set Dest = Application.InputBox("Select destination cell", _

    "Select Destination", , , , , , 8)

On Error GoTo 0
 

    If sRange Is Nothing Or Dest Is Nothing Then

            MsgBox "Inavlid Range"

            Exit Sub

    Else

        If Dest.Rows.Count <> 1 Or Dest.Columns.Count <> 1 Then

            MsgBox "Destination must be a single cell"

            Exit Sub

        Else

            If MsgBox("Copy from " & sRange.Address & " to " & Dest.Address, vbOKCancel) = vbOK Then

                sRange.Copy Destination:=Dest

            End If

        End If

    End If

End Sub

ΥΓ. Γιώργο το δουλεύαμε παράλληλα :icon_yes:

Καλησπέρα
Με βάση το ζητούμενο ότι η Range είναι σταθερά η C3:I72
και αντιγράφετε και επικολλάτε σε κελί της C στήλης κατ' επιλογήν
Μπορεί αυτός ο κώδικας να είναι αρκετός

Sub copypaste()
Range("C3:I72").Copy
With Selection
.PasteSpecial
End With

End Sub