[VBA] Μεταφορά δεδομένων από ένα βιβλίο σε άλλο με βάση ημερομηνία που εισάγεται

[girapas]

Στο συνημμένο GBook1.xls (Sheet1) ο χρήστης δίνει μία ημερομηνία και καταχωρεί τα δεδομένα, όπου προβλέπεται. Με ποιό κώδικα, μετά το πάτημα του ΟΚ, μπορούν να μεταφέρονται, αυτομάτως, τα δεδομένα στα αντίστοιχα κελιά του ανοικτού βιβλίου GBook2.xls (Sheet1) βρίσκοντας σε αυτό στην ίδια ημερομηνία που δόθηκε στο πρώτο βιβλίο;
Ευχαριστώ,
Γιώργος Π.

[GeorgeK]

Καλησπέρα Γιώργο,

Με το συννημένο μπορείς να κάνεις αυτό που ζητάς. Θα αντιγράψει τα δεδομένα που θες στο βιβλίο GBook2 και στο κελί που ζητάς βάσει ημερομηνίας.

Επειδή χρειάζεται να γνωρίζει κάποιος το path του δεύτερου αρχείου για να γίνει η αντιγραφή το οποίο δεν το ξέρω όπως το έκανα θα χρειαστείς να επιλέγεις το αρχείο στο οποίο θα γίνεται η αντιγραφή. Θα καταλάβεις τι εννοώ μόλις το τρέξεις.

Εσύ δε θα βλέπεις τη διαδικασία. Θα γίνεται η αντιγραφή στο δεύτερο βιβλίο, θα αποθηκεύονται οι αλλαγές και θα κλείνει το βιβλίο GBook2 χωρίς εσύ να το βλέπεις.

Υπάρχουν και άλλοι τρόποι αλλά με αυτό θα κάνεις τη δουλειά σου εύκολα

Ελπίζω να σε βοήθησα

Γιώργος

[Tasos]

Καλημέρα σε όλους!

Εναλλακτικά μπορεί να αντιστοιχηθεί ο παρακάτω κώδικας στο κουμπί "CommandButton1" στο βιβλίο "GBook1.xls":

Private Sub CommandButton1_Click()
' μεταφορά δεδομένων, της ίδιας ημερομηνίας, από GBook1.xls στο GBook2.xls
    Dim wb As Workbook, c As Range, wbName As Variant, wbWasClosed As Boolean

    If Not IsDate(Me.Range("B1")) Then Exit Sub

    If Dir(ThisWorkbook.Path & "\GBook2.xls", vbDirectory) <> vbNullString Then
        wbName = ThisWorkbook.Path & "\GBook2.xls"
    Else
        wbName = Application.GetOpenFilename("Αρχεία Excel, *.xls", , "Αναζήτηση βιβλίου...")
    End If

    If wbName <> False Then
        Application.ScreenUpdating = False
        Set wb = GetObject(wbName)
        wbWasClosed = Not wb.Windows(1).Visible
        If wbWasClosed Then wb.Windows(1).Visible = True  'Το εμφανίζω γιατί στο XL 15 δημιουργείται προβλήμα
        With wb.Worksheets(1)
            Set c = .Range("A:A").Find(Me.Range("B1"), LookIn:=xlValues)
            If Not c Is Nothing Then
                .Range(.Cells(c.Row, 2), .Cells(c.Row, 4)).Value = Me.Range(Me.Cells(3, 2), Me.Cells(3, 4)).Value
                .Range(.Cells(c.Row, 5), .Cells(c.Row, 7)).Value = Me.Range(Me.Cells(4, 2), Me.Cells(4, 4)).Value
                wb.Save
            End If
        End With
        If wbWasClosed Then
            wb.Close False
        End If
    End If
End Sub

Καλή συνέχεια!

Τάσος

[Spirosgr]

Καλησπέρα
Προς κάθε ενδιαφερόμενο το βιβλίο που ακολουθεί περιέχει μια εντελώς
διαφορετική προσέγγιση στο θέμα.
Με βάση τα στοιχεία του ζητούμενου θα μπορούσαμε να αποφύγουμε
τα δύο βιβλία και να έχουμε ένα.
Αν για παράδειγμα το πρώτο βιβλίο περιέχει τα στοιχεία (δεδομένα) μιας εργάσιμης ημέρας και θέλουμε να τα αρχειοθετήσουμε στο δεύτερο με το πάτημα του κουμπιού τότε:
Το μοναδικό μας πλέον βιβλίο περιέχει ένα φύλλο υπολογισμών, ένα πρότυπο μηνός στο οποίο με κουμπί "φέρνει" τις εργάσιμες μέρες επιλεγμένου μήνα, έτους και αποθηκεύει
αντίγραφο του μήνα την τελευταία μέρα αφού ολοκληρωθεί ημερολογιακά ο μήνας.
Κατόπιν επιλέγουμε τον επόμενο μήνα και επαναλαμβάνουμε την διαδικασία.
Μπορούμε να έχουμε ένα τέτοιο βιβλίο για κάθε έτος.
Οι λεπτομέρειες αναλυτικά μέσα στο βιβλίο.
Καλή συνέχεια!

[girapas]

Ευχαριστώ τους GeorgeK και Tasos για την πολύτιμη βοήθειά τους. Και οι δύο λύσεις δουλεύουν άψογα.
Επίσης, εξαιρετικά ενδιαφέρουσα -και για άλλες εφαρμογές- είναι η προσέγγιση του spyrosgr.