2 Kapalı Dosya Arası Veri Kopyalama

[schlecht]

Merhaba iyi geceler,
2 excel dosyasını açmadan birinden diğerine veri aktarımı yapmak mümkün müdür?

 

[Murat OSMA]

Merhabalar,

Bu başıkta aradığınızdan fazlasını bulacaksınız..
http://www.excel.web.tr/f117/​

 

[schlecht]

Verdiğiniz başlığı inceledim fakat istediğim kopyalama işlevine rastlayamadım.
Ekte yer alan kapalı1 deki verileri kapalı3 teki sayfa1 e, kapalı2 deki verileri kapalı3 teki sayfa2 ye kopyalamak istiyorum. Ancak kapalı3 dosyasına herhangi bir kod ve buton eklememem gerekiyor. kapalı3 dosyası açık olabilir. Fakat belirttiğim gibi kapalı3 dosyasına buton vs. eklenmemesi gerekiyor.

Bu mümkün müdür?

 

[schlecht]

Fikri olan biri yok mu acaba ? Yardımcı olursanız sevinirim.

 

[BedriA]

Emin olmamakla birlikte;

Bu üç dosya dışında yeni bir excel dosyası açılarak, bu sayfada yazılacak kodlar ile kapalı dosyalar arasında veri alışverişi sağlanabilir.

Elimde bunu yapacak bir kod yok ama bunun mümkün olduğunu düşünüyorum.

Kolay gelsin.

 

[schlecht]

Evet dediğiniz gibi bir transfer yapmak istiyorum. Forumda aradım fakat bulamadım. Elinde olan varsa paylaşırsa sevinirim. Cevabınız için teşekkürler.

 

[Korhan Ayhan]

Bu dosyalarınızın hepsini aynı klasöre alın.

Klasör içinde yeni bir excel çalışma kitabı oluşturun. Bu kitabın içine aşağıdaki kodu uygulayıp çalıştırın.

Sub AKTAR()
    Dim Excel_Uygulama As Object, Yol As String, Dosya_Adi As String
    Dim K1 As Object, K2 As Object, S1 As Worksheet, Son As Long
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Set Excel_Uygulama = CreateObject("Excel.Application")
    Excel_Uygulama.Visible = False
    
    Yol = ThisWorkbook.Path
    
    Dosya_Adi = Yol & "\kapalı3.xlsx"
    Set K1 = Excel_Uygulama.Workbooks.Open(Dosya_Adi)
    
    Dosya_Adi = Yol & "\kapalı1.xlsx"
    Set K2 = Excel_Uygulama.Workbooks.Open(Dosya_Adi)
    Set S1 = K2.Sheets("Sayfa1")
    
    Son = S1.Cells(S1.Rows.Count, 2).End(3).Row
    S1.Range("B2:G" & Son).Copy K1.Sheets("Sayfa1").Range("B2")
    K2.Close
    
    Dosya_Adi = Yol & "\kapalı2.xlsx"
    Set K2 = Excel_Uygulama.Workbooks.Open(Dosya_Adi)
    Set S1 = K2.Sheets("Sayfa1")
    
    Son = S1.Cells(S1.Rows.Count, 2).End(3).Row
    S1.Range("B2:I" & Son).Copy K1.Sheets("Sayfa2").Range("B2")
    K2.Close
    
    K1.Save
    K1.Close
    
    Set S1 = Nothing
    Set K1 = Nothing
    Set K2 = Nothing
    Set Excel_Uygulama = Nothing

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[schlecht]

Hocam çok teşekkür ederim cevap verdiğiniz için. 3 dosyayı aynı klasöre aldım. Yeni bir excel sayfasında kodu çalıştırdım.

Set K1 = Excel_Uygulama.Workbooks.Open(Dosya_Adi)

burada hata verdi.​

 

[Korhan Ayhan]

"kapalı3.xlsx" isimli dosyanızın varlığını kontrol ediniz.