Αντιγράψτε κελιά από τη σειρά ActiveCell σε ένα φύλλο βάσης δεδομένων χρησιμοποιώντας VBA στο Microsoft Excel

Πίνακας περιεχομένων

Στο Microsoft Excel, μπορούμε να αντιγράψουμε κελιά από τη σειρά activecell σε ένα συγκεκριμένο φύλλο. Σε αυτό το άρθρο θα χρησιμοποιήσουμε τον κώδικα VBA για τη μεταφορά δεδομένων από κάθε φύλλο και τη συγχώνευση των δεδομένων σε ένα φύλλο εργασίας. Θα προσθέσουμε ένα κύριο φύλλο στο βιβλίο εργασίας και θα αποθηκεύσουμε τα δεδομένα από το καθορισμένο εύρος σε ένα φύλλο.

Τα παραδείγματα κωδικών θα αντιγραφούν σε ένα φύλλο βάσης δεδομένων με το όνομα Sheet2. Κάθε φορά που εκτελούμε μακροεντολή, τα κελιά θα τοποθετούνται κάτω από την τελευταία σειρά με δεδομένα μετά την τελευταία στήλη στο φύλλο 2. Αυτή η μακροεντολή θα αντιγράψει τα κελιά από τη στήλη A, D από το ActiveCell.

Ακολουθεί η εικόνα των δειγμάτων δεδομένων:

Για να αντιγράψετε κελιά από τη σειρά activecell στο Sheet2. πρέπει να ακολουθήσουμε τα παρακάτω βήματα για να ξεκινήσουμε τον επεξεργαστή VB:

  • Κάντε κλικ στην καρτέλα Προγραμματιστής
  • Από την ομάδα κώδικα επιλέξτε Visual Basic

  • Κάντε κλικ στην επιλογή Εισαγωγή και στη συνέχεια ενότητα

  • Αυτό θα δημιουργήσει νέα ενότητα
  • Εισαγάγετε τον ακόλουθο κώδικα στην Τυπική μονάδα
Sub CopyCells () Dim sourceRange As Range Dim disrange As Range Dim Lr As Long Lr = LastRow (Sheets ("Sheet2")) + 1 Set sourceRange = Sheets ("Sheet1"). Cells (_ ActiveCell.Row, 1) .Range ("A1: D1") Set defrange = Sheets ("Sheet2"). Range ("A" & Lr) sourceRange.Copy destrange End Sub 
Sub CopyCellsValues ​​() Dim sourceRange As Range Dim disrange As Range Dim Lr As Long Lr = LastRow (Sheets ("Sheet2")) + 1 Set sourceRange = Sheets ("Sheet1"). Cells (_ ActiveCell.Row, 1) .Range ("A1: D1") Με sourceRange Set destrange = Sheets ("Sheet2"). Range ("A" _ & Lr). Resize (.Rows.Count, .Columns.Count) End with destrange.Value = sourceRange.Value Τέλος υπο 
Λειτουργία LastRow (sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find (What: = "*", _ After: = sh.Range ("A1"), _ Lookat: = xlPart, _ LookIn: = xlFormulas , _ SearchOrder: = xlByRows, _ SearchDirection: = xlΠροηγούμενο, _ MatchCase: = False). Σφάλμα σειράς On GoTo 0 End Function 
Συνάρτηση Lastcol (sh As Worksheet) On Error Resume Next Lastcol = sh.Cells.Find (What: = "*", _ After: = sh.Range ("A1"), _ Lookat: = xlPart, _ LookIn: = xlFormulas , _ SearchOrder: = xlByColumns, _ SearchDirection: = xlΠροηγούμενο, _ MatchCase: = False). Σφάλμα στήλης On GoTo 0 End Function 

  • Για να ελέγξετε τον παραπάνω κωδικό VBA. προσθέστε δεδομένα στην περιοχή "A1: D1" και, στη συνέχεια, εκτελέστε τη μακροεντολή πατώντας το πλήκτρο συντόμευσης F5
  • Τα δεδομένα που αποθηκεύονται στο καθορισμένο εύρος θα αντιγραφούν στο "Sheet2" ξεκινώντας από το A1

  • Εάν εκτελέσουμε ξανά αυτήν τη μακροεντολή. τα δεδομένα θα αποθηκευτούν στην επόμενη σειρά. ανατρέξτε στην παρακάτω εικόνα:

  • Μπορούμε να αλλάξουμε το εύρος στην παραπάνω μακροεντολή που ταιριάζει στις απαιτήσεις μας

Συμπέρασμα: Με την παραπάνω μακροεντολή μπορούμε να αντιγράψουμε κελιά από τη σειρά ενεργού κυττάρου σε ένα νέο φύλλο χρησιμοποιώντας κώδικα VBA.

Αν σας άρεσαν τα ιστολόγια μας, μοιραστείτε το με τους φίλους σας στο Facebook. Επίσης, μπορείτε να μας ακολουθήσετε στο Twitter και το Facebook.

Θα θέλαμε πολύ να σας ακούσουμε, ενημερώστε μας πώς μπορούμε να βελτιώσουμε, να συμπληρώσουμε ή να καινοτομήσουμε το έργο μας και να το κάνουμε καλύτερο για εσάς. Γράψτε μας στον ιστότοπο email

Θα βοηθήσει στην ανάπτυξη του τόπου, μοιράζονται τη σελίδα με τους φίλους σας

wave wave wave wave wave