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

[anestaki]

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

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

[Tasos]

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

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

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

Τάσος

[anestaki]

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

[Tasos]

Καλημέρα!

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

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

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

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

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

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

Φιλικά

Τάσος