Forum - VBA Μεταφορά δεδομένων από ένα βιβλίο εργασίας σε άλλο βιβλίο εργασίας.

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

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

- - [VBA] Μεταφορά δεδομένων από ένα βιβλίο εργασίας σε άλλο βιβλίο εργασίας. (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/2133-metafora-dedomenon-apo-ena-biblio-ergasias-se-allo-biblio-ergasias.html)

Μεταφορά δεδομένων από ένα βιβλίο εργασίας σε άλλο βιβλίο εργασίας.

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

Sub Workbook_Open()
Application.ScreenUpdating = False
Range("Φύλλο! c1").Copy
Dim MyWorkbook As Workbook
Dim g As String
On Error GoTo Errhandler
With Workbooks("biblio.xlsm")
g = .FullName
.Open SaveChanges:=True
End With
Range("Αρχική! a7").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Set MyWorkbook = ActiveWorkbook
On Error GoTo 0
Errhandler:
MsgBox "xxxxxx"
End Sub

Καλημέρα!
Γιώργο δοκίμασε:

Κώδικας:

Option Explicit
 

Sub test()

    Dim wb As Workbook, wbFullName As String, wbWasOpen As Boolean
 

    wbFullName = ThisWorkbook.Path & "\Book2.xlsm"    'Προσάρμοσε το όνομα του βιβλίου προορισμού
 

    For Each wb In Application.Workbooks

        If wb.FullName = wbFullName Then

            wbWasOpen = True

            Exit For

        End If

    Next
 

    If wb Is Nothing Then Set wb = ThisWorkbook
 

    On Error GoTo ExitHere
 

    If wb.FullName <> wbFullName Then

        Workbooks.Open Filename:=wbFullName, ReadOnly:=False

    End If
 

    With Application

        .Calculation = xlCalculationManual

        .ScreenUpdating = False

        .EnableEvents = False
 

        Set wb = ActiveWorkbook
 

        ' Στην παρακάτω γραμμή προσάρμοσε τα ονόματα των φύλλων και τις διευθύνσεις των περιοχών των 2 βιβλίων.

        ' Οι διευθύνσεις των περιοχών των 2 βιβλίων μπορούν να διαφέρουν αλλά

        ' οι στήλες και οι γραμμές πρέπει να έχουν το ίδιο πλήθος.

        wb.Sheets("Αρχική").Range("A1:G100").Value = ThisWorkbook.Sheets("Sheet1").Range("A1:G100").Value
 

        If wbWasOpen Then

            wb.Save

            wb.Close

        End If
 

ExitHere:

        If Err <> 0 Then MsgBox Err & vbLf & Err.Description

        .Calculation = xlCalculationAutomatic

        .EnableEvents = True

        .ScreenUpdating = True

    End With
 

End Sub

Ο κώδικας αυτός κλείνει το βιβλίο προορισμού μετά από τη μεταφορά δεδομένων μόνο αν το βιβλίο ήταν κλειστό πριν την εκτέλεση της μακροεντολής.

Τάσος

Καλησπέρα σε όλους
Τάσο δεν σας ξέχασα αλλά με την αλλαγή πάροχου έχω αρκετά προβλήματα με την σύνδεση σε ευχαριστώ πολύ και πάλι όπως πάντα δούλεψε άψογα.
Επίσης θέλω να ευχαριστήσω και τον Σπύρο για την βοήθεια του σε άλλο post.

Καλημέρα!

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

Ένας υπολογιστής μπορεί να έχει περισσότερους δίσκους (εσωτερικούς - εξωτερικούς ή USB Stick)
Αναλόγως τον υπολογιστή και το λειτουργικό, μια τέτοιου είδους αναζήτηση μπορεί να διαρκέσει αρκετά λεπτά.

Το βασικό πρόβλημα όμως είναι ότι το αρχείο ή τα αρχεία που θα βρεθούν μπορεί να μην έχουν σχέση με την εφαρμογή σου ή να ανήκουν σε άλλο χρήστη.

Πιστεύω ότι θα πρέπει να επανεξετάσεις τη σχεδίαση της εφαρμογής σου σε ότι έχει σχέση με αναζήτηση + διαγραφή αρχείων.

Εκτός αυτού θα σε παρακαλούσα να ανοίξεις νέο θέμα αφού το ζητούμενο σου δεν έχει σχέση με τον τίτλο αυτού του θέματος.

Περιμένουμε νέα σου

Φιλικά

Τάσος