Excel Forum

Excel Forum (http://www.excel.web.tr/index.php)
-   Makro-VBA (http://www.excel.web.tr/forumdisplay.php?f=48)
-   -   Kapalı dosyadan veri alma (http://www.excel.web.tr/showthread.php?t=168038)

ozuberk 10-11-2017 09:25

Kapalı dosyadan veri alma
 
Merhaba,

Aynı klasör içinde birden fazla kapalı Excel kitabından Kasım adlı kitap sayfalarına veri almak istiyorum. Makroyu çalıştırdığımda Kasım adlı kitabın sayfalarında J1 de kapalı olan kitapların ismi yazılı olan sayfalardaki verileri alsın. Alınacak verideki kitabın adı ile sayfanın adı aynı. Veriler değişkenlik gösterebilir. Alınak verilerin başlangıç yeri A3:E aralığında Kasım adlı kitaba kopyalanacak alan A2:E aralığı.

Örneğin: Kasım adlı kitabın Sayfa1 adlı sayfasının J1 hücresinde 01112017, Sayfa2 adlı sayfasının J1 hücresinde 02112017 yazıyor.

Yardımcı olabilecek arkadaşlara şimdiden teşekkür ederim.

askm 10-11-2017 13:07

Kod:

Sub askm_dosyalar()
Dim aktif As Workbook, sh As Worksheet, a As Long
Dim klasor As Object, evn As Object, xls As Object
    Set sh = ThisWorkbook.Worksheets("01.11.2017")
    Set evn = CreateObject("scripting.filesystemobject")
    Set klasor = evn.getfolder(ThisWorkbook.Path)
        For Each xls In klasor.Files
            If LCase(Mid(xls.shortname, InStr(1, xls.shortname, ".", 1) + 1)) = "xls" Then
            If xls.Name <> "ÖRNEK DOSYA.xls" Then
                Workbooks.Open (xls.Path)
                    Set aktif = ActiveWorkbook
                    Sayfa_ismi = Mid(aktif.Name, 2, 2) & "." & Mid(aktif.Name, 4, 2) & "." & Mid(aktif.Name, 6, 4)
                    Set sh = ThisWorkbook.Worksheets(Sayfa_ismi)
                    a = aktif.Sheets(1).Range("a65536").End(3).Row
                    aktif.Sheets(1).Range("a2:l" & a).Copy
                    sh.Range("a65536").End(3)(2, 1).PasteSpecial xlPasteValues
                    aktif.Close False
            End If
            End If
        Next xls
    a = Empty
    Set sh = Nothing
    Set evn = Nothing
    Set aktif = Nothing
    Set klasor = Nothing
    MsgBox "Aktarma işlemi tamamlandı...", vbInformation, "ASKM"
End Sub


ozuberk 10-11-2017 13:42

Merhaba ilginiz için teşekkür ederim. Kodu çalıştırdığımda hata veriyor ve uyarılar çıkıyor. Daha sonra kod bölümündeki Workbooks.Open (xls.Path) sarı renk ile işaretleniyor.

askm 10-11-2017 13:46

Dosyanızın adını xls.Name <> "ÖRNEK DOSYA.xls" kısmına tam yazdınız mı? Uzantı dahil.

ozuberk 10-11-2017 13:59

Evet Kasım.xlsm olarak düzelttim.

PLİNT 10-11-2017 20:33

Merhaba
Arkadaşlar affınıza sığınarak;
Açık dosya aynı klasör içinde olduğu için gizli (gölge) "Kasım" dosyasını açmaya çalşıyor olabilir.
Kod:

  If xls.Name <> ThisWorkbook.Name And InStr(xls.Name, "~") = 0 Then

ozuberk 13-11-2017 16:57

Merhaba,

Kodu değiştirdiğimde sorun düzeldi. Yardımlarınız için çok teşekkür ederim.
Bende affınıza sığınarak iki sorum olacak;
1) Set sh = ThisWorkbook.Worksheets("01.11.2017") sayfa ismi değişiklik gösterebilir. Örneğin 01.12.2017, 01.01.2018... gibi
2) Kod ikinci defa çalıştığında alt alta yapıştırıyor. Bunun yerine A2 başlangıç olsun mükerrer kayıt yapmasın.


Saat 11:42

Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.