[VBA] Επικόλληση δεδομένων στην επόμενη άδεια στήλη

[caudillo]

Καλησπέρα σε όλο το forum.
Ξεκινώντας από μια ιδέα φίλου, άρχισα να φτιάχνω ένα αρχείο excel όπου θα καταχωρούνται οι εργασίες συντήρησης του αυτοκινήτου.
Έχω φτιάξει ένα φύλλο όπου καταχωρούνται τα στοιχεία ιδιοκτήτη και αυτοκινήτου και από κάτω έχω μια στήλη με τις εργασίες συντήρησης, τα χιλιομετρικά διαστήματα μεταξύ των εργασιών κ.λ.π. ενώ στην τελευταία στήλη συμπληρώνονται τα κόστη κάθε εργασίας.
Σε δεύτερο φύλλο - όπου θέλω να λειτουργεί σαν ιστορικό αποθήκευσης των service - έχω βάλει πάλι κάποια από τα στοιχεία του αυτοκινήτου και από κάτω σε μια στήλη τις ίδιες εργασίες συντήρησης.
Εκείνο που θέλω είναι όποτε ενημερώνω το πρώτο φύλλο με τα κόστη κάποιων εργασιών να μπορώ να αντιγράφω τα κόστη αυτά στο δεύτερο φύλλο, δίπλα από τα ήδη υπάρχοντα (στην επόμενη δηλαδή άδεια στήλη).
Μέχρι στιγμής έχω φτιάξει (με καταγραφή μακροεντολής) έναν κώδικα όπου αντιγράφει τα δεδομένα που θέλω από το πρώτο φύλλο. Αλλά δεν ξέρω πως να διαμορφώσω τον κώδικα ώστε να τα επικολλά στην επόμενη άδεια στήλη, με αποτέλεσμα να αντικαθιστά αυτά που ήδη είχαν επικολληθεί.
Παραθέτω τον κώδικα, ώστε αν μπορεί και θέλει κάποιος να βοηθήσει:

Sub copyandpaste()

    Range("C10:C11").Select
    Selection.Copy
    Sheets("Αποθήκευση").Select
    Range("B6:B7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Αρχείο σέρβις οχήματος").Select
    Range("Υπηρεσία[[#All],[Στήλη3]]").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Αποθήκευση").Select
    Range("B9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Αρχείο σέρβις οχήματος").Select
    Range("F20").Select
End Sub

Ευχαριστώ πολύ και καλή συνέχεια σε όλους.

[pierta]

Καλησπέρα,

Δοκίμασε αυτό να δεις εαν λειτουργεί


Sub copyandpaste()

Range("C10:C11").Select
Selection.Copy
Sheets("Αποθήκευση").Select
Range("B6:B7").Select

Cells.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Αρχείο σέρβις οχήματος").Select
Range("Υπηρεσία[[#All],[Στήλη3]]").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Αποθήκευση").Select
Range("B9").Select

Cells.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Αρχείο σέρβις οχήματος").Select
Range("F20").Select
End Sub

[caudillo]

Δημήτρη καλησπέρα.
Αρχικά σε ευχαριστώ πάρα πολύ για τον χρόνο σου και την διάθεση να με βοηθήσεις.
Δοκίμασα την πρότασή σου και μου βγάζει runtime error 1004 και ότι όλα τα συγχωνευμένα κελιά πρέπει να έχουν το ίδιο μέγεθος.
Λόγω προσωπικής αδυναμίας με την VBA, αν θέλεις και μπορείς, μου εξηγείς τι πρέπει να διορθωθεί.
Και πάλι σε ευχαριστώ.

[caudillo]

Καλησπέρα Δημήτρη.
Συνεχίζοντας να δοκιμάζω την πρότασή σου, είδα ότι τα νέα δεδομένα συνεχίζουν να επικολούνται στην πρώτη στήλη αντί στην επόμενη (άδεια) διαθέσιμη.
Ελπίζω να μπορέσεις να βρεις τι πρέπει να αλλάξει.
Καλή συνέχεια.

[caudillo]

Καλημέρα.
Συνεχίζοντας την προσπάθεια να καταφέρουμε να κάνουμε τον κώδικα να δουλέψει, τον τροποποίησα ως εξής:

Sub copyandpaste()

Dim sws As Worksheet
Dim dws As Worksheet

Set sws = Sheets("Αρχείο σέρβις οχήματος")
Set dws = Sheets("Αποθήκευση")


Sheets("Αρχείο σέρβις οχήματος").Select
Range("C10:C11").Select
Selection.Copy
dws.Select
Range("B6:B7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
Sheets("Αρχείο σέρβις οχήματος").Select
Range("H20:H40").Select
Selection.Copy
dws.Select
Range("B9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
dws.Activate

End Sub

Από ότι καταλαβαίνω, νομίζω ότι πρέπει να τροποποιηθούν οι γραμμές Range("B6:B7").Select και Range("B9").Select ώστε σε κάθε νέα αντιγραφή να γίνεται επικόλληση των νέων δεδομένων στην επόμενη άδεια στήλη. Δηλαδή C6:C7 και C9, D6:D7 και D9 και ούτω καθεξής.
Η ερώτηση -που εγώ δεν μπορώ να απαντήσω- είναι πως τροποποιούμε αυτές τις δυο γραμμές;
Οποιαδήποτε βοήθεια θα είναι ανεκτίμητη.
Ευχαριστώ.

[pierta]

Για δες τον κώδικα από το συνημμένο, το δοκίμασα σε αρχεία και μάλλον είναι αυτό που θέλεις.

[caudillo]

Καλησπέρα Δημήτρη.
Έκανα κάποιες πρώτες δοκιμές και όλα φαίνονται να δουλεύουν όπως πρέπει!
Σ' ευχαριστώ πολύ για τον χρόνο και τον κόπο σου.
Καλή συνέχεια σε ότι κάνεις.